view libinterp/corefcn/typecast.cc @ 31605:e88a07dec498 stable

maint: Use macros to begin/end C++ namespaces. * oct-conf-post-public.in.h: Define two macros (OCTAVE_BEGIN_NAMESPACE, OCTAVE_END_NAMESPACE) that can be used to start/end a namespace. * mk-opts.pl, build-env.h, build-env.in.cc, __betainc__.cc, __contourc__.cc, __dsearchn__.cc, __eigs__.cc, __expint__.cc, __ftp__.cc, __gammainc__.cc, __ichol__.cc, __ilu__.cc, __isprimelarge__.cc, __lin_interpn__.cc, __magick_read__.cc, __pchip_deriv__.cc, __qp__.cc, amd.cc, auto-shlib.cc, auto-shlib.h, balance.cc, base-text-renderer.cc, base-text-renderer.h, besselj.cc, bitfcns.cc, bsxfun.cc, c-file-ptr-stream.cc, c-file-ptr-stream.h, call-stack.cc, call-stack.h, ccolamd.cc, cellfun.cc, chol.cc, colamd.cc, colloc.cc, conv2.cc, daspk.cc, dasrt.cc, dassl.cc, data.cc, data.h, debug.cc, defaults.cc, defaults.h, defun-int.h, defun.cc, det.cc, dirfns.cc, display.cc, display.h, dlmread.cc, dmperm.cc, dot.cc, dynamic-ld.cc, dynamic-ld.h, eig.cc, ellipj.cc, environment.cc, environment.h, error.cc, error.h, errwarn.h, event-manager.cc, event-manager.h, event-queue.cc, event-queue.h, fcn-info.cc, fcn-info.h, fft.cc, fft2.cc, fftn.cc, file-io.cc, filter.cc, find.cc, ft-text-renderer.cc, ft-text-renderer.h, gcd.cc, getgrent.cc, getpwent.cc, getrusage.cc, givens.cc, gl-render.cc, gl-render.h, gl2ps-print.cc, gl2ps-print.h, graphics-toolkit.cc, graphics-toolkit.h, graphics.cc, graphics.in.h, gsvd.cc, gtk-manager.cc, gtk-manager.h, hash.cc, help.cc, help.h, hess.cc, hex2num.cc, hook-fcn.cc, hook-fcn.h, input.cc, input.h, interpreter-private.cc, interpreter-private.h, interpreter.cc, interpreter.h, inv.cc, jsondecode.cc, jsonencode.cc, kron.cc, latex-text-renderer.cc, latex-text-renderer.h, load-path.cc, load-path.h, load-save.cc, load-save.h, lookup.cc, ls-ascii-helper.cc, ls-ascii-helper.h, ls-oct-text.cc, ls-utils.cc, ls-utils.h, lsode.cc, lu.cc, mappers.cc, matrix_type.cc, max.cc, mex-private.h, mex.cc, mgorth.cc, nproc.cc, oct-fstrm.cc, oct-fstrm.h, oct-hdf5-types.cc, oct-hdf5-types.h, oct-hist.cc, oct-hist.h, oct-iostrm.cc, oct-iostrm.h, oct-opengl.h, oct-prcstrm.cc, oct-prcstrm.h, oct-procbuf.cc, oct-procbuf.h, oct-process.cc, oct-process.h, oct-stdstrm.h, oct-stream.cc, oct-stream.h, oct-strstrm.cc, oct-strstrm.h, oct-tex-lexer.in.ll, oct-tex-parser.yy, ordqz.cc, ordschur.cc, pager.cc, pager.h, pinv.cc, pow2.cc, pr-flt-fmt.cc, pr-output.cc, procstream.cc, procstream.h, psi.cc, qr.cc, quad.cc, quadcc.cc, qz.cc, rand.cc, rcond.cc, regexp.cc, schur.cc, settings.cc, settings.h, sighandlers.cc, sighandlers.h, sparse-xdiv.cc, sparse-xdiv.h, sparse-xpow.cc, sparse-xpow.h, sparse.cc, spparms.cc, sqrtm.cc, stack-frame.cc, stack-frame.h, stream-euler.cc, strfind.cc, strfns.cc, sub2ind.cc, svd.cc, sylvester.cc, symbfact.cc, syminfo.cc, syminfo.h, symrcm.cc, symrec.cc, symrec.h, symscope.cc, symscope.h, symtab.cc, symtab.h, syscalls.cc, sysdep.cc, sysdep.h, text-engine.cc, text-engine.h, text-renderer.cc, text-renderer.h, time.cc, toplev.cc, tril.cc, tsearch.cc, typecast.cc, url-handle-manager.cc, url-handle-manager.h, urlwrite.cc, utils.cc, utils.h, variables.cc, variables.h, xdiv.cc, xdiv.h, xnorm.cc, xnorm.h, xpow.cc, xpow.h, __delaunayn__.cc, __fltk_uigetfile__.cc, __glpk__.cc, __init_fltk__.cc, __init_gnuplot__.cc, __ode15__.cc, __voronoi__.cc, audiodevinfo.cc, audioread.cc, convhulln.cc, fftw.cc, gzip.cc, mk-build-env-features.sh, mk-builtins.pl, cdef-class.cc, cdef-class.h, cdef-fwd.h, cdef-manager.cc, cdef-manager.h, cdef-method.cc, cdef-method.h, cdef-object.cc, cdef-object.h, cdef-package.cc, cdef-package.h, cdef-property.cc, cdef-property.h, cdef-utils.cc, cdef-utils.h, ov-base.cc, ov-base.h, ov-bool-mat.cc, ov-builtin.h, ov-cell.cc, ov-class.cc, ov-class.h, ov-classdef.cc, ov-classdef.h, ov-complex.cc, ov-fcn-handle.cc, ov-fcn-handle.h, ov-fcn.h, ov-java.cc, ov-java.h, ov-mex-fcn.h, ov-null-mat.cc, ov-oncleanup.cc, ov-struct.cc, ov-typeinfo.cc, ov-typeinfo.h, ov-usr-fcn.cc, ov-usr-fcn.h, ov.cc, ov.h, octave.cc, octave.h, mk-ops.sh, op-b-b.cc, op-b-bm.cc, op-b-sbm.cc, op-bm-b.cc, op-bm-bm.cc, op-bm-sbm.cc, op-cdm-cdm.cc, op-cell.cc, op-chm.cc, op-class.cc, op-cm-cm.cc, op-cm-cs.cc, op-cm-m.cc, op-cm-s.cc, op-cm-scm.cc, op-cm-sm.cc, op-cs-cm.cc, op-cs-cs.cc, op-cs-m.cc, op-cs-s.cc, op-cs-scm.cc, op-cs-sm.cc, op-dm-dm.cc, op-dm-scm.cc, op-dm-sm.cc, op-dm-template.cc, op-dms-template.cc, op-fcdm-fcdm.cc, op-fcm-fcm.cc, op-fcm-fcs.cc, op-fcm-fm.cc, op-fcm-fs.cc, op-fcn.cc, op-fcs-fcm.cc, op-fcs-fcs.cc, op-fcs-fm.cc, op-fcs-fs.cc, op-fdm-fdm.cc, op-fm-fcm.cc, op-fm-fcs.cc, op-fm-fm.cc, op-fm-fs.cc, op-fs-fcm.cc, op-fs-fcs.cc, op-fs-fm.cc, op-fs-fs.cc, op-i16-i16.cc, op-i32-i32.cc, op-i64-i64.cc, op-i8-i8.cc, op-int-concat.cc, op-m-cm.cc, op-m-cs.cc, op-m-m.cc, op-m-s.cc, op-m-scm.cc, op-m-sm.cc, op-mi.cc, op-pm-pm.cc, op-pm-scm.cc, op-pm-sm.cc, op-pm-template.cc, op-range.cc, op-s-cm.cc, op-s-cs.cc, op-s-m.cc, op-s-s.cc, op-s-scm.cc, op-s-sm.cc, op-sbm-b.cc, op-sbm-bm.cc, op-sbm-sbm.cc, op-scm-cm.cc, op-scm-cs.cc, op-scm-m.cc, op-scm-s.cc, op-scm-scm.cc, op-scm-sm.cc, op-sm-cm.cc, op-sm-cs.cc, op-sm-m.cc, op-sm-s.cc, op-sm-scm.cc, op-sm-sm.cc, op-str-m.cc, op-str-s.cc, op-str-str.cc, op-struct.cc, op-ui16-ui16.cc, op-ui32-ui32.cc, op-ui64-ui64.cc, op-ui8-ui8.cc, ops.h, anon-fcn-validator.cc, anon-fcn-validator.h, bp-table.cc, bp-table.h, comment-list.cc, comment-list.h, filepos.h, lex.h, lex.ll, oct-lvalue.cc, oct-lvalue.h, oct-parse.yy, parse.h, profiler.cc, profiler.h, pt-anon-scopes.cc, pt-anon-scopes.h, pt-arg-list.cc, pt-arg-list.h, pt-args-block.cc, pt-args-block.h, pt-array-list.cc, pt-array-list.h, pt-assign.cc, pt-assign.h, pt-binop.cc, pt-binop.h, pt-bp.cc, pt-bp.h, pt-cbinop.cc, pt-cbinop.h, pt-cell.cc, pt-cell.h, pt-check.cc, pt-check.h, pt-classdef.cc, pt-classdef.h, pt-cmd.h, pt-colon.cc, pt-colon.h, pt-const.cc, pt-const.h, pt-decl.cc, pt-decl.h, pt-eval.cc, pt-eval.h, pt-except.cc, pt-except.h, pt-exp.cc, pt-exp.h, pt-fcn-handle.cc, pt-fcn-handle.h, pt-id.cc, pt-id.h, pt-idx.cc, pt-idx.h, pt-jump.h, pt-loop.cc, pt-loop.h, pt-mat.cc, pt-mat.h, pt-misc.cc, pt-misc.h, pt-pr-code.cc, pt-pr-code.h, pt-select.cc, pt-select.h, pt-spmd.cc, pt-spmd.h, pt-stmt.cc, pt-stmt.h, pt-tm-const.cc, pt-tm-const.h, pt-unop.cc, pt-unop.h, pt-vm-eval.cc, pt-walk.cc, pt-walk.h, pt.cc, pt.h, token.cc, token.h, Range.cc, Range.h, idx-vector.cc, idx-vector.h, range-fwd.h, CollocWt.cc, CollocWt.h, aepbalance.cc, aepbalance.h, chol.cc, chol.h, gepbalance.cc, gepbalance.h, gsvd.cc, gsvd.h, hess.cc, hess.h, lo-mappers.cc, lo-mappers.h, lo-specfun.cc, lo-specfun.h, lu.cc, lu.h, oct-convn.cc, oct-convn.h, oct-fftw.cc, oct-fftw.h, oct-norm.cc, oct-norm.h, oct-rand.cc, oct-rand.h, oct-spparms.cc, oct-spparms.h, qr.cc, qr.h, qrp.cc, qrp.h, randgamma.cc, randgamma.h, randmtzig.cc, randmtzig.h, randpoisson.cc, randpoisson.h, schur.cc, schur.h, sparse-chol.cc, sparse-chol.h, sparse-lu.cc, sparse-lu.h, sparse-qr.cc, sparse-qr.h, svd.cc, svd.h, child-list.cc, child-list.h, dir-ops.cc, dir-ops.h, file-ops.cc, file-ops.h, file-stat.cc, file-stat.h, lo-sysdep.cc, lo-sysdep.h, lo-sysinfo.cc, lo-sysinfo.h, mach-info.cc, mach-info.h, oct-env.cc, oct-env.h, oct-group.cc, oct-group.h, oct-password.cc, oct-password.h, oct-syscalls.cc, oct-syscalls.h, oct-time.cc, oct-time.h, oct-uname.cc, oct-uname.h, action-container.cc, action-container.h, base-list.h, cmd-edit.cc, cmd-edit.h, cmd-hist.cc, cmd-hist.h, f77-fcn.h, file-info.cc, file-info.h, lo-array-errwarn.cc, lo-array-errwarn.h, lo-hash.cc, lo-hash.h, lo-ieee.h, lo-regexp.cc, lo-regexp.h, lo-utils.cc, lo-utils.h, oct-base64.cc, oct-base64.h, oct-glob.cc, oct-glob.h, oct-inttypes.h, oct-mutex.cc, oct-mutex.h, oct-refcount.h, oct-shlib.cc, oct-shlib.h, oct-sparse.cc, oct-sparse.h, oct-string.h, octave-preserve-stream-state.h, pathsearch.cc, pathsearch.h, quit.cc, quit.h, unwind-prot.cc, unwind-prot.h, url-transfer.cc, url-transfer.h : Use new macros to begin/end C++ namespaces.
author Rik <rik@octave.org>
date Thu, 01 Dec 2022 14:23:45 -0800
parents 08b08b7f05b2
children aac27ad79be6
line wrap: on
line source

////////////////////////////////////////////////////////////////////////
//
// Copyright (C) 2007-2022 The Octave Project Developers
//
// See the file COPYRIGHT.md in the top-level directory of this
// distribution or <https://octave.org/copyright/>.
//
// This file is part of Octave.
//
// Octave 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 3 of the License, or
// (at your option) any later version.
//
// Octave 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 Octave; see the file COPYING.  If not, see
// <https://www.gnu.org/licenses/>.
//
////////////////////////////////////////////////////////////////////////

#if defined (HAVE_CONFIG_H)
#  include "config.h"
#endif

#include <algorithm>
#include <limits>

#include "mx-base.h"

#include "defun.h"
#include "error.h"
#include "errwarn.h"
#include "ovl.h"
#include "unwind-prot.h"

OCTAVE_BEGIN_NAMESPACE(octave)

static dim_vector
get_vec_dims (const dim_vector& old_dims, octave_idx_type n)
{
  if (old_dims.ndims () == 2 && old_dims(0) == 1)
    return dim_vector (1, n);
  else if (old_dims.ndims () == 2 && old_dims(0) == 0 && old_dims(1) == 0)
    return dim_vector ();
  else
    return dim_vector (n, 1);
}

template <typename ArrayType>
static void
get_data_and_bytesize (const ArrayType& array,
                       const void *& data,
                       octave_idx_type& byte_size,
                       dim_vector& old_dims,
                       unwind_protect& frame)
{
  // The array given may be a temporary, constructed from a scalar or sparse
  // array.  This will ensure the data will be deallocated after we exit.
  frame.add_delete (new ArrayType (array));

  data = reinterpret_cast<const void *> (array.data ());
  byte_size = array.byte_size ();

  old_dims = array.dims ();
}

template <typename ArrayType>
static ArrayType
reinterpret_copy (const void *data, octave_idx_type byte_size,
                  const dim_vector& old_dims)
{
  typedef typename ArrayType::element_type T;
  octave_idx_type n = byte_size / sizeof (T);

  if (n * static_cast<int> (sizeof (T)) != byte_size)
    error ("typecast: incorrect number of input values to make output value");

  ArrayType retval (get_vec_dims (old_dims, n));
  T *dest = retval.fortran_vec ();
  std::memcpy (dest, data, n * sizeof (T));

  return retval;
}

template <typename ArrayType>
static ArrayType
reinterpret_int_copy (const void *data, octave_idx_type byte_size,
                      const dim_vector& old_dims)
{
  typedef typename ArrayType::element_type T;
  typedef typename T::val_type VT;
  octave_idx_type n = byte_size / sizeof (T);

  if (n * static_cast<int> (sizeof (T)) != byte_size)
    error ("typecast: incorrect number of input values to make output value");

  ArrayType retval (get_vec_dims (old_dims, n));
  VT *dest = reinterpret_cast<VT *> (retval.fortran_vec ());
  std::memcpy (dest, data, n * sizeof (VT));

  return retval;
}

DEFUN (typecast, args, ,
       doc: /* -*- texinfo -*-
@deftypefn {} {@var{y} =} typecast (@var{x}, "@var{class}")
Return a new array @var{y} resulting from interpreting the data of @var{x}
in memory as data of the numeric class @var{class}.

Both the class of @var{x} and @var{class} must be one of the built-in
numeric classes:

@example
@group
"logical"
"char"
"int8"
"int16"
"int32"
"int64"
"uint8"
"uint16"
"uint32"
"uint64"
"double"
"single"
"double complex"
"single complex"
@end group
@end example

@noindent
the last two are only used with @var{class}; they indicate that a
complex-valued result is requested.  Complex arrays are stored in memory as
consecutive pairs of real numbers.  The sizes of integer types are given by
their bit counts.  Both logical and char are typically one byte wide;
however, this is not guaranteed by C++.  If your system is IEEE conformant,
single and double will be 4 bytes and 8 bytes wide, respectively.
@qcode{"logical"} is not allowed for @var{class}.

If the input is a row vector, the return value is a row vector, otherwise it
is a column vector.

If the bit length of @var{x} is not divisible by that of @var{class}, an
error occurs.

An example of the use of typecast on a little-endian machine is

@example
@group
@var{x} = uint16 ([1, 65535]);
typecast (@var{x}, "uint8")
@result{} [   1,   0, 255, 255]
@end group
@end example
@seealso{cast, bitpack, bitunpack, swapbytes}
@end deftypefn */)
{
  if (args.length () != 2)
    print_usage ();

  octave_value retval;

  unwind_protect frame;

  const void *data = nullptr;
  octave_idx_type byte_size = 0;
  dim_vector old_dims;

  octave_value array = args(0);

  if (array.islogical ())
    get_data_and_bytesize (array.bool_array_value (), data, byte_size,
                           old_dims, frame);
  else if (array.is_string ())
    get_data_and_bytesize (array.char_array_value (), data, byte_size,
                           old_dims, frame);
  else if (array.isinteger ())
    {
      if (array.is_int8_type ())
        get_data_and_bytesize (array.int8_array_value (), data, byte_size,
                               old_dims, frame);
      else if (array.is_int16_type ())
        get_data_and_bytesize (array.int16_array_value (), data, byte_size,
                               old_dims, frame);
      else if (array.is_int32_type ())
        get_data_and_bytesize (array.int32_array_value (), data, byte_size,
                               old_dims, frame);
      else if (array.is_int64_type ())
        get_data_and_bytesize (array.int64_array_value (), data, byte_size,
                               old_dims, frame);
      else if (array.is_uint8_type ())
        get_data_and_bytesize (array.uint8_array_value (), data, byte_size,
                               old_dims, frame);
      else if (array.is_uint16_type ())
        get_data_and_bytesize (array.uint16_array_value (), data, byte_size,
                               old_dims, frame);
      else if (array.is_uint32_type ())
        get_data_and_bytesize (array.uint32_array_value (), data, byte_size,
                               old_dims, frame);
      else if (array.is_uint64_type ())
        get_data_and_bytesize (array.uint64_array_value (), data, byte_size,
                               old_dims, frame);
    }
  else if (array.iscomplex ())
    {
      if (array.is_single_type ())
        get_data_and_bytesize (array.float_complex_array_value (), data,
                               byte_size, old_dims, frame);
      else
        get_data_and_bytesize (array.complex_array_value (), data,
                               byte_size, old_dims, frame);
    }
  else if (array.isreal ())
    {
      if (array.is_single_type ())
        get_data_and_bytesize (array.float_array_value (), data, byte_size,
                               old_dims, frame);
      else
        get_data_and_bytesize (array.array_value (), data, byte_size,
                               old_dims, frame);
    }
  else
    error ("typecast: invalid input CLASS: %s",
           array.class_name ().c_str ());

  std::string numclass = args(1).string_value ();
  std::transform (numclass.begin (), numclass.end (), numclass.begin (),
                  tolower);

  if (numclass.size () == 0)
    ;
  else if (numclass == "char")
    retval = octave_value (reinterpret_copy<charNDArray>
                           (data, byte_size, old_dims),
                           array.is_dq_string () ? '"' : '\'');
  else if (numclass[0] == 'i')
    {
      if (numclass == "int8")
        retval = reinterpret_int_copy<int8NDArray> (data, byte_size, old_dims);
      else if (numclass == "int16")
        retval = reinterpret_int_copy<int16NDArray> (data, byte_size, old_dims);
      else if (numclass == "int32")
        retval = reinterpret_int_copy<int32NDArray> (data, byte_size, old_dims);
      else if (numclass == "int64")
        retval = reinterpret_int_copy<int64NDArray> (data, byte_size, old_dims);
    }
  else if (numclass[0] == 'u')
    {
      if (numclass == "uint8")
        retval = reinterpret_int_copy<uint8NDArray> (data, byte_size, old_dims);
      else if (numclass == "uint16")
        retval = reinterpret_int_copy<uint16NDArray> (data, byte_size,
                                                      old_dims);
      else if (numclass == "uint32")
        retval = reinterpret_int_copy<uint32NDArray> (data, byte_size,
                                                      old_dims);
      else if (numclass == "uint64")
        retval = reinterpret_int_copy<uint64NDArray> (data, byte_size,
                                                      old_dims);
    }
  else if (numclass == "single")
    retval = reinterpret_copy<FloatNDArray> (data, byte_size, old_dims);
  else if (numclass == "double")
    retval = reinterpret_copy<NDArray> (data, byte_size, old_dims);
  else if (numclass == "single complex")
    retval = reinterpret_copy<FloatComplexNDArray> (data, byte_size,
                                                    old_dims);
  else if (numclass == "double complex")
    retval = reinterpret_copy<ComplexNDArray> (data, byte_size, old_dims);

  if (retval.is_undefined ())
    error ("typecast: cannot convert to %s class", numclass.c_str ());

  return retval;
}

/*
%!assert (typecast (int64 (0), "char"),   char (zeros (1, 8)))
%!assert (typecast (int64 (0), "int8"),   zeros (1, 8, "int8"))
%!assert (typecast (int64 (0), "uint8"),  zeros (1, 8, "uint8"))
%!assert (typecast (int64 (0), "int16"),  zeros (1, 4, "int16"))
%!assert (typecast (int64 (0), "uint16"), zeros (1, 4, "uint16"))
%!assert (typecast (int64 (0), "int32"),  zeros (1, 2, "int32"))
%!assert (typecast (int64 (0), "uint32"), zeros (1, 2, "uint32"))
%!assert (typecast (int64 (0), "int64"),  zeros (1, 1, "int64"))
%!assert (typecast (int64 (0), "uint64"), zeros (1, 1, "uint64"))
%!assert (typecast (int64 (0), "single"), zeros (1, 2, "single"))
%!assert (typecast (int64 (0), "double"), 0)
%!assert (typecast (int64 (0), "single complex"), single (0))
%!assert (typecast (int64 ([0 0]), "double complex"), 0)

%!assert (typecast ([],   "double"), [])
%!assert (typecast (0,    "double"), 0)
%!assert (typecast (inf,  "double"), inf)
%!assert (typecast (-inf, "double"), -inf)
%!assert (typecast (nan,  "double"), nan)

%!error typecast ()
%!error typecast (1)
%!error typecast (1, 2, 3)
%!error typecast (1, "invalid")
%!error typecast (int8 (0), "double")
*/

template <typename ArrayType>
ArrayType
do_bitpack (const boolNDArray& bitp)
{
  typedef typename ArrayType::element_type T;
  octave_idx_type n
    = bitp.numel () / (sizeof (T) * std::numeric_limits<unsigned char>::digits);

  if (n * static_cast<int> (sizeof (T)) *
      std::numeric_limits<unsigned char>::digits != bitp.numel ())
    error ("bitpack: incorrect number of bits to make up output value");

  ArrayType retval (get_vec_dims (bitp.dims (), n));

  const bool *bits = bitp.data ();
  char *packed = reinterpret_cast<char *> (retval.fortran_vec ());

  octave_idx_type m = n * sizeof (T);

  for (octave_idx_type i = 0; i < m; i++)
    {
      char c = bits[0];
      for (int j = 1; j < std::numeric_limits<unsigned char>::digits; j++)
        c |= bits[j] << j;

      packed[i] = c;
      bits += std::numeric_limits<unsigned char>::digits;
    }

  return retval;
}

DEFUN (bitpack, args, ,
       doc: /* -*- texinfo -*-
@deftypefn {} {@var{y} =} bitpack (@var{x}, @var{class})
Return a new array @var{y} resulting from interpreting the logical array
@var{x} as raw bit patterns for data of the numeric class @var{class}.

@var{class} must be one of the built-in numeric classes:

@example
@group
"double"
"single"
"double complex"
"single complex"
"char"
"int8"
"int16"
"int32"
"int64"
"uint8"
"uint16"
"uint32"
"uint64"
@end group
@end example

The number of elements of @var{x} should be divisible by the bit length of
@var{class}.  If it is not, excess bits are discarded.  Bits come in
increasing order of significance, i.e., @code{x(1)} is bit 0, @code{x(2)} is
bit 1, etc.

The result is a row vector if @var{x} is a row vector, otherwise it is a
column vector.
@seealso{bitunpack, typecast}
@end deftypefn */)
{
  if (args.length () != 2)
    print_usage ();

  if (! args(0).islogical ())
    error ("bitpack: X must be a logical array");

  octave_value retval;

  boolNDArray bitp = args(0).bool_array_value ();

  std::string numclass = args(1).string_value ();

  if (numclass.size () == 0)
    ;
  else if (numclass == "char")
    retval = octave_value (do_bitpack<charNDArray> (bitp), '\'');
  else if (numclass[0] == 'i')
    {
      if (numclass == "int8")
        retval = do_bitpack<int8NDArray> (bitp);
      else if (numclass == "int16")
        retval = do_bitpack<int16NDArray> (bitp);
      else if (numclass == "int32")
        retval = do_bitpack<int32NDArray> (bitp);
      else if (numclass == "int64")
        retval = do_bitpack<int64NDArray> (bitp);
    }
  else if (numclass[0] == 'u')
    {
      if (numclass == "uint8")
        retval = do_bitpack<uint8NDArray> (bitp);
      else if (numclass == "uint16")
        retval = do_bitpack<uint16NDArray> (bitp);
      else if (numclass == "uint32")
        retval = do_bitpack<uint32NDArray> (bitp);
      else if (numclass == "uint64")
        retval = do_bitpack<uint64NDArray> (bitp);
    }
  else if (numclass == "single")
    retval = do_bitpack<FloatNDArray> (bitp);
  else if (numclass == "double")
    retval = do_bitpack<NDArray> (bitp);
  else if (numclass == "single complex")
    retval = do_bitpack<FloatComplexNDArray> (bitp);
  else if (numclass == "double complex")
    retval = do_bitpack<ComplexNDArray> (bitp);

  if (retval.is_undefined ())
    error ("bitpack: cannot pack to %s class", numclass.c_str ());

  return retval;
}

/*
%!assert (bitpack (zeros (1, 8,   "logical"), "char"),   "\0")
%!assert (bitpack (zeros (1, 8,   "logical"), "int8"),   int8 (0))
%!assert (bitpack (zeros (1, 8,   "logical"), "uint8"),  uint8 (0))
%!assert (bitpack (zeros (1, 16,  "logical"), "int16"),  int16 (0))
%!assert (bitpack (zeros (1, 16,  "logical"), "uint16"), uint16 (0))
%!assert (bitpack (zeros (1, 32,  "logical"), "int32"),  int32 (0))
%!assert (bitpack (zeros (1, 32,  "logical"), "uint32"), uint32 (0))
%!assert (bitpack (zeros (1, 64,  "logical"), "int64"),  int64 (0))
%!assert (bitpack (zeros (1, 64,  "logical"), "uint64"), uint64 (0))
%!assert (bitpack (zeros (1, 32,  "logical"), "single"), single (0))
%!assert (bitpack (zeros (1, 64,  "logical"), "double"), double (0))
%!assert (bitpack (zeros (1, 64,  "logical"), "single complex"), single (0))
%!assert (bitpack (zeros (1, 128, "logical"), "double complex"), double (0))

%!test <54931>
%! x = false (1, 32);
%! x(1) = true;
%! assert (bitpack (x, "uint32"), uint32 (1));
%! x([1, 9]) = true;
%! assert (bitpack (x, "uint32"), uint32 (257));

%!error bitpack ()
%!error bitpack (1)
%!error bitpack (1, 2, 3)
%!error bitpack (1, "invalid")
%!error bitpack (1, "double")
%!error bitpack (false, "invalid")
%!error bitpack (false, "double")
*/

template <typename ArrayType>
boolNDArray
do_bitunpack (const ArrayType& array)
{
  typedef typename ArrayType::element_type T;
  octave_idx_type n = array.numel () * sizeof (T)
                      * std::numeric_limits<unsigned char>::digits;

  boolNDArray retval (get_vec_dims (array.dims (), n));

  const char *packed = reinterpret_cast<const char *> (array.data ());
  bool *bits = retval.fortran_vec ();

  octave_idx_type m = n / std::numeric_limits<unsigned char>::digits;

  for (octave_idx_type i = 0; i < m; i++)
    {
      char c = packed[i];
      bits[0] = c & 1;
      for (int j = 1; j < std::numeric_limits<unsigned char>::digits; j++)
        bits[j] = (c >>= 1) & 1;
      bits += std::numeric_limits<unsigned char>::digits;
    }

  return retval;
}

DEFUN (bitunpack, args, ,
       doc: /* -*- texinfo -*-
@deftypefn {} {@var{y} =} bitunpack (@var{x})
Return a logical array @var{y} corresponding to the raw bit patterns of
@var{x}.

@var{x} must belong to one of the built-in numeric classes:

@example
@group
"double"
"single"
"char"
"int8"
"int16"
"int32"
"int64"
"uint8"
"uint16"
"uint32"
"uint64"
@end group
@end example

The result is a row vector if @var{x} is a row vector; otherwise, it is a
column vector.
@seealso{bitpack, typecast}
@end deftypefn */)
{
  if (args.length () != 1)
    print_usage ();

  if (! (args(0).isnumeric () || args(0).is_string ()))
    error ("bitunpack: argument must be a number or a string");

  octave_value retval;

  octave_value array = args(0);

  if (array.is_string ())
    retval = do_bitunpack (array.char_array_value ());
  else if (array.isinteger ())
    {
      if (array.is_int8_type ())
        retval = do_bitunpack (array.int8_array_value ());
      else if (array.is_int16_type ())
        retval = do_bitunpack (array.int16_array_value ());
      else if (array.is_int32_type ())
        retval = do_bitunpack (array.int32_array_value ());
      else if (array.is_int64_type ())
        retval = do_bitunpack (array.int64_array_value ());
      else if (array.is_uint8_type ())
        retval = do_bitunpack (array.uint8_array_value ());
      else if (array.is_uint16_type ())
        retval = do_bitunpack (array.uint16_array_value ());
      else if (array.is_uint32_type ())
        retval = do_bitunpack (array.uint32_array_value ());
      else if (array.is_uint64_type ())
        retval = do_bitunpack (array.uint64_array_value ());
    }
  else if (array.iscomplex ())
    {
      if (array.is_single_type ())
        retval = do_bitunpack (array.float_complex_array_value ());
      else
        retval = do_bitunpack (array.complex_array_value ());
    }
  else if (array.isreal ())
    {
      if (array.is_single_type ())
        retval = do_bitunpack (array.float_array_value ());
      else
        retval = do_bitunpack (array.array_value ());
    }
  else
    error ("bitunpack: invalid input class: %s",
           array.class_name ().c_str ());

  return retval;
}

/*
%!assert (bitunpack ("\0"),       zeros (1, 8,  "logical"))
%!assert (bitunpack (int8 (0)),   zeros (1, 8,  "logical"))
%!assert (bitunpack (uint8 (0)),  zeros (1, 8,  "logical"))
%!assert (bitunpack (int16 (0)),  zeros (1, 16, "logical"))
%!assert (bitunpack (uint16 (0)), zeros (1, 16, "logical"))
%!assert (bitunpack (int32 (0)),  zeros (1, 32, "logical"))
%!assert (bitunpack (uint32 (0)), zeros (1, 32, "logical"))
%!assert (bitunpack (int64 (0)),  zeros (1, 64, "logical"))
%!assert (bitunpack (uint64 (0)), zeros (1, 64, "logical"))
%!assert (bitunpack (single (0)), zeros (1, 32, "logical"))
%!assert (bitunpack (double (0)), zeros (1, 64, "logical"))
%!assert (bitunpack (complex (single (0))), zeros (1, 64, "logical"))
%!assert (bitunpack (complex (double (0))), zeros (1, 128, "logical"))

%!error bitunpack ()
%!error bitunpack (1, 2)
%!error bitunpack ({})
*/

OCTAVE_END_NAMESPACE(octave)