1
2
3
4
5
6
7
8
9
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
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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
% Struct functions
% Copyright (C) 2012-2021,2022 John E. Davis
%
% This file is part of the S-Lang Library and may be distributed under the
% terms of the GNU General Public License. See the file COPYING for
% more information.
private define make_indices (num_dims, d, i)
{
_for (0, num_dims-1, 1)
{
variable j = ();
if (j == d)
i;
else
[:];
}
}
define struct_filter (s, i)
{
variable dim = qualifier ("dim");
variable copy = qualifier_exists ("copy");
if (copy)
s = @s;
variable field;
foreach field (get_struct_field_names (s))
{
variable value = get_struct_field (s, field);
if (typeof (value) != Array_Type)
continue;
if (dim == NULL)
{
set_struct_field (s, field, value[i]);
continue;
}
variable dims = array_shape (value);
variable num_dims = length (dims);
variable d = dim;
if (d < 0)
d += num_dims;
if ((d < 0) || (d >= num_dims))
continue;
set_struct_field (s, field, value[make_indices(num_dims, d, i)]);
}
if (copy)
return s;
}
define struct_combine ()
{
variable args = __pop_list (_NARGS);
variable fields = String_Type[0];
variable arg;
foreach arg (args)
{
if (arg == NULL)
continue;
if (is_struct_type (arg))
arg = get_struct_field_names (arg);
fields = [fields, arg];
}
% Get just the unique names
variable i, a = Assoc_Type[Int_Type];
ifnot (length (fields))
return NULL;
_for i (0, length (fields)-1, 1)
a[fields[i]] = i;
i = assoc_get_values (a);
fields = fields[i[array_sort (i)]];
variable s = @Struct_Type (fields);
foreach arg (args)
{
if (0 == is_struct_type (arg))
continue;
foreach (get_struct_field_names (arg))
{
variable field = ();
set_struct_field (s, field, get_struct_field (arg, field));
}
}
return s;
}
define struct_field_exists (s, field)
{
return length (where (field == get_struct_field_names (s)));
}
$1 = path_concat (path_dirname (__FILE__), "help/structfuns.hlp");
if (NULL != stat_file ($1))
add_doc_file ($1);
provide ("structfuns");
|
