Line data    Source code

       1             : % Struct functions
       2             : % Copyright (C) 2012-2021,2022 John E. Davis
       3             : %
       4             : % This file is part of the S-Lang Library and may be distributed under the
       5             : % terms of the GNU General Public License.  See the file COPYING for
       6             : % more information.
       7             : private define make_indices (num_dims, d, i)
       8             : {
       9           6 :    _for (0, num_dims-1, 1)
      10             :      {
      11          14 :         variable j = ();
      12          14 :         if (j == d)
      13           6 :           i;
      14             :         else
      15           8 :           [:];
      16             :      }
      17             : }
      18             : 
      19             : define struct_filter (s, i)
      20             : {
      21           4 :    variable dim = qualifier ("dim");
      22           4 :    variable copy = qualifier_exists ("copy");
      23           4 :    if (copy)
      24           4 :      s = @s;
      25             : 
      26             :    variable field;
      27           4 :    foreach field (get_struct_field_names (s))
      28             :      {
      29          15 :         variable value = get_struct_field (s, field);
      30          15 :         if (typeof (value) != Array_Type)
      31           5 :           continue;
      32          10 :         if (dim == NULL)
      33             :           {
      34           1 :              set_struct_field (s, field, value[i]);
      35           1 :              continue;
      36             :           }
      37           9 :         variable dims = array_shape (value);
      38           9 :         variable num_dims = length (dims);
      39           9 :         variable d = dim;
      40           9 :         if (d < 0)
      41           0 :           d += num_dims;
      42             : 
      43           9 :         if ((d < 0) || (d >= num_dims))
      44           3 :           continue;
      45             : 
      46           6 :         set_struct_field (s, field, value[make_indices(num_dims, d, i)]);
      47             :      }
      48           4 :    if (copy)
      49           4 :      return s;
      50             : }
      51             : 
      52             : define struct_combine ()
      53             : {
      54           1 :    variable args = __pop_list (_NARGS);
      55           1 :    variable fields = String_Type[0];
      56             :    variable arg;
      57           1 :    foreach arg (args)
      58             :      {
      59           2 :         if (arg == NULL)
      60           0 :           continue;
      61           2 :         if (is_struct_type (arg))
      62           2 :           arg = get_struct_field_names (arg);
      63           2 :         fields = [fields, arg];
      64             :      }
      65             : 
      66             :    % Get just the unique names
      67           1 :    variable i, a = Assoc_Type[Int_Type];
      68           1 :    ifnot (length (fields))
      69           0 :      return NULL;
      70           1 :    _for i (0, length (fields)-1, 1)
      71           6 :      a[fields[i]] = i;
      72           1 :    i = assoc_get_values (a);
      73           1 :    fields = fields[i[array_sort (i)]];
      74             : 
      75           1 :    variable s = @Struct_Type (fields);
      76           1 :    foreach arg (args)
      77             :      {
      78           2 :         if (0 == is_struct_type (arg))
      79           0 :           continue;
      80           2 :         foreach (get_struct_field_names (arg))
      81             :           {
      82           6 :              variable field = ();
      83           6 :              set_struct_field (s, field, get_struct_field (arg, field));
      84             :           }
      85             :      }
      86           1 :    return s;
      87             : }
      88             : 
      89             : define struct_field_exists (s, field)
      90             : {
      91           2 :    return length (where (field == get_struct_field_names (s)));
      92             : }
      93             : 
      94           1 : $1 = path_concat (path_dirname (__FILE__), "help/structfuns.hlp");
      95           1 : if (NULL != stat_file ($1))
      96           1 :   add_doc_file ($1);
      97             : 
      98           1 : provide ("structfuns");