line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Algorithm::Shape::RandomTree; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
28536
|
use Moose; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
use namespace::autoclean; |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
use Algorithm::Shape::RandomTree::Branch; |
7
|
|
|
|
|
|
|
use Algorithm::Shape::RandomTree::Branch::Point; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
## Attributes ## |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
has 'stem_length' => ( is => 'ro', isa => 'Int' ); # Length of stem |
14
|
|
|
|
|
|
|
has 'tree_width' => ( is => 'ro', isa => 'Int' ); # Width of stem |
15
|
|
|
|
|
|
|
has 'stem_curve' => ( is => 'ro', isa => 'Int' ); # Curvature and complexity of stem |
16
|
|
|
|
|
|
|
has 'branch_length' => ( is => 'ro', isa => 'Int' ); # Average (non-stem) branch length |
17
|
|
|
|
|
|
|
has 'branch_stdev' => ( is => 'ro', isa => 'Int' ); # Plus-minus range around the average |
18
|
|
|
|
|
|
|
has 'complexity' => ( is => 'ro', isa => 'Int' ); # Branching modifier: max number of |
19
|
|
|
|
|
|
|
# branches sprouting from a node |
20
|
|
|
|
|
|
|
has 'branch_curve' => ( is => 'ro', isa => 'Num' ); # Average curvature of (non-stem) |
21
|
|
|
|
|
|
|
# branches |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# Nodulation: determins the number of levels of sub-branching |
24
|
|
|
|
|
|
|
has 'nodulation' => ( is => 'ro', isa => 'Int' ); |
25
|
|
|
|
|
|
|
# Ebbing Factor: Determins how quickly the nodulation decreases along the tree |
26
|
|
|
|
|
|
|
has 'ebbing_factor' => ( is => 'ro', isa => 'Int', default => 2 ); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# Creation algorithm: can be either linear or recursive |
29
|
|
|
|
|
|
|
# Linear gives more control but looks slightly less natural |
30
|
|
|
|
|
|
|
has 'creation_algorithm' => ( is => 'ro', isa => 'Str', default => 'recursive' ); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
has 'branches' => ( |
33
|
|
|
|
|
|
|
is => 'ro', |
34
|
|
|
|
|
|
|
isa => 'ArrayRef', |
35
|
|
|
|
|
|
|
traits => [ 'Array' ], |
36
|
|
|
|
|
|
|
default => sub { [ ] }, |
37
|
|
|
|
|
|
|
handles => { |
38
|
|
|
|
|
|
|
add_branch => 'push', |
39
|
|
|
|
|
|
|
count_branches => 'count', |
40
|
|
|
|
|
|
|
filter_branches => 'grep', |
41
|
|
|
|
|
|
|
}, |
42
|
|
|
|
|
|
|
); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# These two determine the amount of change in branch length and angle |
45
|
|
|
|
|
|
|
# between branches, and along the whole shape of the tree |
46
|
|
|
|
|
|
|
has 'dx_range' => ( is => 'ro', isa => 'Int' ); |
47
|
|
|
|
|
|
|
has 'dy_range' => ( is => 'ro', isa => 'Int' ); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
has 'verbose' => ( is => 'ro', isa => 'Bool' ); |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# TODO: Determines whether the tree's shape is more dominated by a single stem with |
52
|
|
|
|
|
|
|
# shorter and less developed sub-branches, or is highly complex and branching. |
53
|
|
|
|
|
|
|
# An apically dominant tree will have one dominant stem with many branches |
54
|
|
|
|
|
|
|
# sprouting out of it, throughout it's length. ** Not yet implemented (I still |
55
|
|
|
|
|
|
|
# need to think how to do this). ** |
56
|
|
|
|
|
|
|
# The easier model is the non-apically-dominant tree, with modular branches. |
57
|
|
|
|
|
|
|
has 'apical_dominance' => ( is => 'ro', isa => 'Int' ); |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# This is the width of the image on which the tree will be rendered, in pixels |
60
|
|
|
|
|
|
|
has 'image_width' => ( is => 'ro', isa => 'Int' ); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
## Methods ## |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub create_tree { |
66
|
|
|
|
|
|
|
my $self = shift; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
my $verb = $self->verbose; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
$verb && print "[create_tree] Starting\n"; |
71
|
|
|
|
|
|
|
$verb && print "[create_tree] algorithm is $self->creation_algorithm\n"; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
if ( $self->creation_algorithm eq 'recursive' ) { |
74
|
|
|
|
|
|
|
# Create main stem |
75
|
|
|
|
|
|
|
my $stem = $self->create_stem; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
$verb && print "[create_tree] creating primary branches\n"; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# Create primary branches and recurse all sub-branches |
80
|
|
|
|
|
|
|
foreach my $branch ( 1 .. $self->complexity ) { |
81
|
|
|
|
|
|
|
$verb && print "[create_tree] \t creating primary branch $branch\n"; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
$self->create_branches_recursive( $stem ); |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
} else { |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# Set number of branching levels |
89
|
|
|
|
|
|
|
my $levels = $self->nodulation; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
$verb && print "[create_tree] creating $levels levels\n"; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
foreach my $level ( 0 .. $levels ) { |
94
|
|
|
|
|
|
|
$verb && print "[create_tree] \t creating level $level\n"; |
95
|
|
|
|
|
|
|
$self->create_branches( $level ); |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# Create Branches: Linear branch creating function |
101
|
|
|
|
|
|
|
sub create_branches { |
102
|
|
|
|
|
|
|
my ( $self, $level ) = @_; |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
my $verb = $self->verbose; |
105
|
|
|
|
|
|
|
$verb && print "[create_branches] Starting\n"; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
my $branch_num; |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# If it's the first level, the stem and primary branches need to be created |
110
|
|
|
|
|
|
|
if ( $level == 1 ) { |
111
|
|
|
|
|
|
|
my $stem = $self->create_stem; |
112
|
|
|
|
|
|
|
$branch_num = $self->complexity; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# Create primary branches |
115
|
|
|
|
|
|
|
foreach my $branch ( 1 .. $branch_num ) { |
116
|
|
|
|
|
|
|
$self->create_branch( $stem, $level ); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
} else { |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# Get the current level's parent branches |
122
|
|
|
|
|
|
|
# ( i.e. the previous level's branches ) |
123
|
|
|
|
|
|
|
my @parent_branches = $self->filter_branches( |
124
|
|
|
|
|
|
|
sub { $_->level = ( $level - 1 ) } |
125
|
|
|
|
|
|
|
); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
foreach my $parent ( @parent_branches ) { |
128
|
|
|
|
|
|
|
# Number of sub branches |
129
|
|
|
|
|
|
|
my $sub_branches = int( rand( $self->complexity ) ); |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# Create sub-branches for the current parent branch |
132
|
|
|
|
|
|
|
foreach my $idx ( 1 .. $sub_branches ) { |
133
|
|
|
|
|
|
|
$self->create_branch( $parent, $level ); |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# Create Stem: creates the primary branch (stem) for in both recursive and |
140
|
|
|
|
|
|
|
# linear tree creating algorithms |
141
|
|
|
|
|
|
|
sub create_stem { |
142
|
|
|
|
|
|
|
my $self = shift; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
my $verb = $self->verbose; |
145
|
|
|
|
|
|
|
$verb && print "[create_stem] Starting\n"; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
my $d = $self->stem_length; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# Set stem slope ( currently it's stragight up - slope = 0 ) |
150
|
|
|
|
|
|
|
my $m = 0; |
151
|
|
|
|
|
|
|
# To set the slope to a random number between -/+0.5: |
152
|
|
|
|
|
|
|
# my $m = -0.5 + rand(1); |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# Set starting coordinates for the Tree's stem |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# Stem's X position is in the middle of the image |
157
|
|
|
|
|
|
|
my $x_start = int( $self->image_width / 2 ); |
158
|
|
|
|
|
|
|
# Y position is of 1st point is on the ground. |
159
|
|
|
|
|
|
|
my $y_start = 0; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# Mathematically speaking: |
162
|
|
|
|
|
|
|
# Stem length = distance between it's start and end points: |
163
|
|
|
|
|
|
|
# d = sqrt[ (x2-x1)**2 + (y2-y1)**2 ] = sqrt( dx**2 + dy**2 ) |
164
|
|
|
|
|
|
|
# Slope: |
165
|
|
|
|
|
|
|
# m = dy / dx = (y2-y1) / (x2-x1) |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
# After development and a applying the square-root: |
168
|
|
|
|
|
|
|
# y = sqrt[ d**2 / ( m**2 + 1 ) ] + y1 |
169
|
|
|
|
|
|
|
# x = m * (y1 - y) + x1 |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
my $y_end = int( |
172
|
|
|
|
|
|
|
sqrt( $d ** 2 / ( ( $m ** 2 ) + 1 ) + $y_start ) |
173
|
|
|
|
|
|
|
); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
my $x_end = int( |
176
|
|
|
|
|
|
|
$m * ( $y_end - $y_start ) + $x_start |
177
|
|
|
|
|
|
|
); |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# Create stem coordinates |
181
|
|
|
|
|
|
|
my $start_point = Algorithm::Shape::RandomTree::Branch::Point->new( |
182
|
|
|
|
|
|
|
x => $x_start, y => $y_start, |
183
|
|
|
|
|
|
|
); |
184
|
|
|
|
|
|
|
my $end_point = Algorithm::Shape::RandomTree::Branch::Point->new( |
185
|
|
|
|
|
|
|
x => $x_end, y => $y_end, |
186
|
|
|
|
|
|
|
); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
$verb && print "[create_stem] \tcreating stem\n"; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
my $stem = Algorithm::Shape::RandomTree::Branch->new( |
191
|
|
|
|
|
|
|
name => 1, |
192
|
|
|
|
|
|
|
start_point => $start_point, |
193
|
|
|
|
|
|
|
end_point => $end_point, |
194
|
|
|
|
|
|
|
dx => $x_end - $x_start, |
195
|
|
|
|
|
|
|
dy => $y_end - $y_start, |
196
|
|
|
|
|
|
|
level => 0, |
197
|
|
|
|
|
|
|
nodulation => $self->nodulation, |
198
|
|
|
|
|
|
|
complexity => $self->complexity, |
199
|
|
|
|
|
|
|
width => $self->tree_width, |
200
|
|
|
|
|
|
|
); |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# Add stem to branches collection |
203
|
|
|
|
|
|
|
$self->add_branch( $stem ); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
return $stem; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# Linear algorithm's branch creation sub |
209
|
|
|
|
|
|
|
sub create_branch { |
210
|
|
|
|
|
|
|
my ( $self, $parent, $level ) = @_; |
211
|
|
|
|
|
|
|
my $start_point = $parent->end_point; |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
my $verb = $self->verbose; |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
my ( $dx, $dy ) = $self->calc_new_deltas( $parent ); |
216
|
|
|
|
|
|
|
my ( $x_end, $y_end ) = $self->calc_new_endpoints( |
217
|
|
|
|
|
|
|
$start_point, $dx, $dy |
218
|
|
|
|
|
|
|
); |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
my $end_point = Algorithm::Shape::RandomTree::Branch::Point->new( |
221
|
|
|
|
|
|
|
x => $x_end, y => $y_end |
222
|
|
|
|
|
|
|
); |
223
|
|
|
|
|
|
|
my $number = $self->count_branches + 1; # New branch's num (name) |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
my $newbranch = Algorithm::Shape::RandomTree::Branch->new( |
226
|
|
|
|
|
|
|
name => $number, |
227
|
|
|
|
|
|
|
start_point => $start_point, |
228
|
|
|
|
|
|
|
end_point => $end_point, |
229
|
|
|
|
|
|
|
dx => $dx, |
230
|
|
|
|
|
|
|
dy => $dy, |
231
|
|
|
|
|
|
|
level => $level, |
232
|
|
|
|
|
|
|
parent => $parent, |
233
|
|
|
|
|
|
|
# nodulation => , |
234
|
|
|
|
|
|
|
# complexity => , |
235
|
|
|
|
|
|
|
); |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
$self->add_branch( $newbranch ); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# Calculate New Deltas: uses the parent branch's attributes and random factors |
242
|
|
|
|
|
|
|
# to modify a new branche's dx and dy values, who determin the angle and length |
243
|
|
|
|
|
|
|
# of the new branch. |
244
|
|
|
|
|
|
|
sub calc_new_deltas { |
245
|
|
|
|
|
|
|
my ( $self, $parent ) = @_; |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
my $verb = $self->verbose; |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
# Get parent branch's deltas |
250
|
|
|
|
|
|
|
my $old_dx = $parent->dx; |
251
|
|
|
|
|
|
|
my $old_dy = $parent->dy; |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# Calculate modifiers: |
254
|
|
|
|
|
|
|
# These slightly change the dx and dy to create variation and randomness |
255
|
|
|
|
|
|
|
# in branches lengths and angles. |
256
|
|
|
|
|
|
|
# Modifiers range from -range_value to +range_value |
257
|
|
|
|
|
|
|
my $dx_modifier = ( |
258
|
|
|
|
|
|
|
int( rand( $self->dx_range ) * -1 ) + |
259
|
|
|
|
|
|
|
int( rand( $self->dx_range ) ) |
260
|
|
|
|
|
|
|
); |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
my $dy_modifier = ( |
263
|
|
|
|
|
|
|
int( rand( $self->dy_range ) * -1 ) + |
264
|
|
|
|
|
|
|
int( rand( $self->dy_range ) ) |
265
|
|
|
|
|
|
|
); |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
# If the level is 0, it's the stem's children, so the falloff should be 1.5 |
268
|
|
|
|
|
|
|
# (so that they would still be a bit shorter than the stem). |
269
|
|
|
|
|
|
|
# otherwise, it should be the level + 1 |
270
|
|
|
|
|
|
|
my $falloff = ( $parent->level == 0 ) ? 1.5 : $parent->level + 1; |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
# Apply modifiers |
273
|
|
|
|
|
|
|
my $new_dx = int ( ( $old_dx + $dx_modifier ) / $falloff ); |
274
|
|
|
|
|
|
|
my $new_dy = int ( ( $old_dy + $dy_modifier ) / $falloff ); |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
return( $new_dx, $new_dy ); |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# Calculate New End-points: ( by adding the deltas to the start-points ) |
280
|
|
|
|
|
|
|
sub calc_new_endpoints { |
281
|
|
|
|
|
|
|
my ( $self, $start_point, $dx, $dy ) = @_; |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
my $x_end = $dx + $start_point->x; |
284
|
|
|
|
|
|
|
my $y_end = $dy + $start_point->y; |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
return( $x_end, $y_end ); |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# The recursive algorithm for creating all non-stem branches |
290
|
|
|
|
|
|
|
sub create_branches_recursive { |
291
|
|
|
|
|
|
|
my ( $self, $parent ) = @_; |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
my $verb = $self->verbose; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
my $name = $parent->name; |
296
|
|
|
|
|
|
|
$verb && print "[create_branches_recursive] on parent: $name\n"; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# Create a new branch connected to parent |
299
|
|
|
|
|
|
|
my $branch = $self->make_branch( $parent ); |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
# Create this branche's sub-branches |
302
|
|
|
|
|
|
|
if ( $branch->nodulation ) { |
303
|
|
|
|
|
|
|
foreach my $idx ( 1 .. $branch->complexity ) { |
304
|
|
|
|
|
|
|
$verb && print qq{ |
305
|
|
|
|
|
|
|
[create_branches_recursive] \tcreating $name 's branches\n |
306
|
|
|
|
|
|
|
}; |
307
|
|
|
|
|
|
|
$self->create_branches_recursive( $branch ); |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
# Sub for creating single branches used by the recursive algorithm |
313
|
|
|
|
|
|
|
sub make_branch { |
314
|
|
|
|
|
|
|
my ( $self, $parent ) = @_; |
315
|
|
|
|
|
|
|
my $start_point = $parent->end_point; |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
my $verb = $self->verbose; |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
my $name = $parent->name; |
320
|
|
|
|
|
|
|
$verb && print "[make_branche] on parent: $name\n"; |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
my ( $dx, $dy ) = $self->calc_new_deltas( $parent ); |
323
|
|
|
|
|
|
|
my ( $x_end, $y_end ) = $self->calc_new_endpoints( |
324
|
|
|
|
|
|
|
$start_point, $dx, $dy |
325
|
|
|
|
|
|
|
); |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
my $end_point = Algorithm::Shape::RandomTree::Branch::Point->new( |
328
|
|
|
|
|
|
|
x => $x_end, y => $y_end |
329
|
|
|
|
|
|
|
); |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
my $number = $self->count_branches + 1; # New branch's num (name) |
332
|
|
|
|
|
|
|
my $nodulation = $self->calc_new_nodulation( $parent ); |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
my $complexity = int( rand( $self->complexity ) ); # Calculate new complexity |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
# Calculate new width, and prevent a less than 1 width |
337
|
|
|
|
|
|
|
my $falloff = ( $parent->level == 0 ) ? 1.5 : $parent->level + 1; |
338
|
|
|
|
|
|
|
my $new_width = int ( $self->tree_width / $falloff ); |
339
|
|
|
|
|
|
|
my $width = $new_width ? $new_width : 1; |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
my $path_str = $self->create_path( $start_point, $end_point, $dx, $dy ); |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
my $newbranch = Algorithm::Shape::RandomTree::Branch->new( |
344
|
|
|
|
|
|
|
name => $number, |
345
|
|
|
|
|
|
|
start_point => $start_point, |
346
|
|
|
|
|
|
|
end_point => $end_point, |
347
|
|
|
|
|
|
|
dx => $dx, |
348
|
|
|
|
|
|
|
dy => $dy, |
349
|
|
|
|
|
|
|
level => $parent->level + 1, |
350
|
|
|
|
|
|
|
parent => $parent, |
351
|
|
|
|
|
|
|
nodulation => $nodulation, |
352
|
|
|
|
|
|
|
complexity => $complexity, |
353
|
|
|
|
|
|
|
width => $width, |
354
|
|
|
|
|
|
|
path_string => $path_str, |
355
|
|
|
|
|
|
|
); |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
$verb && print "[make_branche] \tmaking branch $number\n"; |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
$self->add_branch( $newbranch ); |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
return $newbranch; |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
sub calc_new_nodulation { |
365
|
|
|
|
|
|
|
my ( $self, $parent ) = @_; |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
my $verb = $self->verbose; |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
my $old = $parent->nodulation; |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
# Reduce ebbing factor from the parent's nodulation |
372
|
|
|
|
|
|
|
my $new = $old - $self->ebbing_factor; |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
return $new; |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
sub create_path { |
378
|
|
|
|
|
|
|
my ( $self, $start, $end, $dx, $dy ) = @_; |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
my $x1 = $start->x; |
381
|
|
|
|
|
|
|
my $y1 = $start->y; |
382
|
|
|
|
|
|
|
my $x2 = $end->x; |
383
|
|
|
|
|
|
|
my $y2 = $end->y; |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
my $length = sqrt( $dx ** 2 + $dy ** 2 ); |
386
|
|
|
|
|
|
|
my $phandle = $self->branch_curve * $length; |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# X / Y values of control point 1 (curving the start point) |
389
|
|
|
|
|
|
|
my $c1_x = $x1 - rand($phandle) + rand($phandle); |
390
|
|
|
|
|
|
|
my $c1_y = $y1 - rand($phandle) + rand($phandle); |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# X / Y values of control point 2 (curving the end point) |
393
|
|
|
|
|
|
|
my $c2_x = $x2 - rand($phandle) + rand($phandle); |
394
|
|
|
|
|
|
|
my $c2_y = $y2 - rand($phandle) + rand($phandle); |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
my $d_str = "M $x1 $y1 C $c1_x $c1_y $c2_x $c2_y $x2 $y2"; |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
return $d_str; |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
no Moose; |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
1; |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
__END__ |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
=head1 NAME |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
Algorithm::Shape::RandomTree - Create an object representing a procedural, editable, randomized plant shape that |
410
|
|
|
|
|
|
|
can be rendered graphically by other modules. |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=head1 VERSION |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
Version 0.01 |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=head1 SYNOPSIS |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
A detailed synopsis with examples will be released soon. |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=head1 EXPORT |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
A list of functions that can be exported. You can delete this section |
423
|
|
|
|
|
|
|
if you don't export anything, such as for a purely object-oriented module. |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=head2 calc_new_deltas |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
=head2 calc_new_endpoints |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=head2 calc_new_nodulation |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=head2 create_branch |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=head2 create_branches |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
=head2 create_branches_recursive |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=head2 create_path |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
=head2 create_stem |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
=head2 create_tree |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
=head2 make_branch |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=head1 AUTHOR |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
Tamir Lousky, C<< <tlousky at cpan.org> >> |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
=head1 BUGS |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<bug-algorithm-shape-randomtree at rt.cpan.org>, or through |
454
|
|
|
|
|
|
|
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Algorithm-Shape-RandomTree>. I will be notified, and then you'll |
455
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=head1 SUPPORT |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
perldoc Algorithm::Shape::RandomTree |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
You can also look for information at: |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
=over 4 |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Algorithm-Shape-RandomTree> |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
L<http://annocpan.org/dist/Algorithm-Shape-RandomTree> |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
=item * CPAN Ratings |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/Algorithm-Shape-RandomTree> |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
=item * Search CPAN |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/Algorithm-Shape-RandomTree/> |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
=back |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
Copyright 2010 Tamir Lousky. |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
495
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
496
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |