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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
# Copyright (c) 1997-2015
# Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
# http://www.polymake.org
#
# 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, or (at your option) any
# later version: http://www.gnu.org/licenses/gpl.txt.
#
# 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.
#-------------------------------------------------------------------------------
# @category Data Conversion
# Change the type of the polymake object to one of its base types
# (aka ancestor in the inheritance hierarchy).
# The object loses all properties that are unknown in the target type.
# @tparam Target the desired new type
# @param Object object to be modified
# @return Object the same //object//, but with modified type
user_function cast<Target>(Core::Object) { $_[0]->cast_me(typeof Target); }
# @category Utilities
# Returns the maximal element of an array.
# @param ARRAY array
# @example > print maximum([1,2,3,4,5,6,7,23]);
# | 23
user_function maximum($) {
my ($data)=@_;
my $max;
assign_max($max, $_) for @$data;
return $max;
}
# @category Utilities
# Returns the minimal element of an array.
# @param ARRAY array
# @example > print minimum([23,42,666]);
# | 23
user_function minimum($) {
my ($data)=@_;
my $min;
assign_min($min, $_) for @$data;
return $min;
}
# @category Utilities
# Returns the average value of the array elements.
# @param ARRAY array
# @example > print average([1,2,3]);
# | 2
user_function average($) {
my ($data)=@_;
my $n=@$data or return;
my $s=0;
$s+= $_ for @$data;
return $s/$n;
}
# @category Utilities
# Produce a histogram of an array: each different element value is mapped on the number of its occurences.
# @param ARRAY data
# @return Map<Element, Int>
# @example > $H = histogram([1,1,2,2,2,3,3,2,3,3,1,1,1,3,2,3]);
# > print $H;
# | {(1 5) (2 5) (3 6)}
user_function histogram {
my ($data)=@_;
return unless @$data;
my $element_type=Core::PropertyType::guess_element_type($data);
my $map=(typeof Map($element_type, typeof Int))->construct->();
++$map->{$_} for @$data;
$map
}
# @category Utilities
# Returns the first //m// Fibonacci numbers.
# @param Int m
# @return ARRAY
user_function fibonacci {
my ($m) = @_;
my @numbers;
if ($m>=1) {
push @numbers, 1;
if ($m>=2) {
push @numbers, 1;
for (my $i=2; $i<$m; ++$i) {
push @numbers, $numbers[$i-1]+$numbers[$i-2];
}
}
}
return @numbers;
}
# FIXME: replace with C++ function from PowerSet.h ?
# k, item, item, ... => list of k_subsets: [ item, ... ], ...
function all_subsets_of_k {
my $k=shift;
my $n=@_;
croak( "parameter k=$k out of range" ) if $k<0 || $k>$n;
return [] if !$k;
my @result;
my @index=0..$k-1;
my $ptr=$k-1;
while (1) {
push @result, [ @_[@index] ];
next if ++$index[$ptr] < $n;
do {
return @result if --$ptr<0;
} while ((++$index[$ptr])+$k-$ptr > $n);
while ($ptr<$k-1) {
++$ptr;
$index[$ptr]=$index[$ptr-1]+1;
}
}
}
# Takes (vertex) labels and incidence information to produce new (facet) labels.
function induced_labels(Array, IncidenceMatrix) {
my ($v_labels, $incidence)=@_;
new Array<String>( map { join(",", @$v_labels[ @$_ ]) } @$incidence);
}
# @category Utilities
# Find the given labels in an array and return their indices.
# @param Array<String> array
# @param String label label ...
# @return Int Int ...
function find_labels {
my $array=shift;
my %asked;
my $notfound=@_;
foreach (@_) {
$asked{$_}++ and croak( "label $_ occurs twice" );
}
my @ret;
my $i=0;
foreach (@$array) {
if (delete $asked{$_}) {
push @ret, $i;
--$notfound or last;
}
++$i;
}
if ($notfound) {
if ($notfound>1) {
croak( "Labels ", join(", ", keys %asked), " do not exist" );
} else {
croak( "Label ", keys(%asked), " does not exist" );
}
}
@ret;
}
# @category Utilities
# Return a map indexing an array of sets
# @param Array<Set<Int>> array
# @return Map<Array<Set<Int>>, Int>
# @example > $s1 = new Set(1,2,3);
# > $s2 = $s2 - 1;
# > $a = new Array<Set>($s1,$s2,$s1);
# > print index_of($a);
# | {({1 2 3} 2) ({2 3} 1)}
user_function index_of {
my $array = shift;
my $index_of = new Map<Set<Int>, Int>;
my $i=0;
foreach (@{$array}) {
$index_of->{$_} = $i++;
}
$index_of;
}
# Local Variables:
# mode: perl
# cperl-indent-level:3
# indent-tabs-mode:nil
# End:
|
