ETJ / PDL-Graphics-TriD-2.100 / TriD / MathGraph.pm 

            

              
—
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

              
=head1 NAME
PDL::Graphics::TriD::MathGraph -- Mathematical Graph objects for PDL
=head1 SYNOPSIS
see the file Demos/TriD/tmathgraph.p in the PDL distribution.
=head1 WARNING
This module is experimental and the interface will probably change.
=head1 DESCRIPTION
This module exists for plotting mathematical graphs (consisting
of nodes and arcs between them) in 3D and optimizing the placement of
the nodes so that the graph is visualizable in a clear way.
=head1 AUTHOR
Copyright (C) 1997 Tuomas J. Lukka (lukka@husc.harvard.edu).
All rights reserved. There is no warranty. You are allowed
to redistribute this software / documentation under certain
conditions. For details, see the file COPYING in the PDL
distribution. If this file is separated from the PDL distribution,
the copyright notice should be included in the file.
=cut
package PDL::Graphics::TriD::MathGraph;
use strict;
use warnings;
use PDL::Graphics::TriD::Objects;
use base qw/PDL::Graphics::TriD::GObject/;
use OpenGL qw(:all);
use PDL::Graphics::OpenGL::Perl::OpenGL;
sub gdraw {
        my($this,$points) = @_;
        glDisable(&GL_LIGHTING);
        glColor3d(@{$this->{Options}{Color}});
        PDL::Graphics::OpenGLQ::gl_arrows($points,@{$this->{Options}}{qw(From To
                ArrowLen ArrowWidth)});
        glEnable(&GL_LIGHTING);
}
sub get_valid_options {
        return {UseDefcols => 0,From => [],To => [],Color => [1,1,1],
                ArrowWidth => 0.02, ArrowLen => 0.1}
}
package PDL::GraphEvolver;
use PDL::Lite;
use PDL::ImageND ":Func";
sub new {
        my($type,$coords) = @_;
        bless {Coords => $coords,
                BoxSize => 3, DMult => 5000,
                A => -100.0, B => -5, C => -0.1, D => 0.01,
                M => 30, MS => 1,
        },$type;
}
sub set_links { my $this = shift; @$this{qw(From To Strength)} = @_; }
sub set_fixed { my $this = shift; @$this{qw(FInd FCoord)} = @_; }
sub step {
        my($this) = @_;
        my $c = $this->{Coords};
        my $velr = repulse($c,@$this{qw(BoxSize DMult A B C D)});
        my $vela = attract($c,@$this{qw(From To Strength M MS)});
        my $tst = 0.10;
        $this->{Velo} = ($this->{Velo}//0) + $tst * 0.02 * ($velr + $vela);
        $this->{Velo} *=
          (0.92*50/(50+$this->{Velo}->magnover->dummy(0)))**$tst;
        $c += $tst * 0.05 * $this->{Velo};
        $c->transpose->index($this->{FInd}->dummy(0)) .= $this->{FCoord}
                if (defined $this->{FInd});
        print "C: $c\n" if $PDL::Graphics::TriD::verbose;
}
sub getcoords {$_[0]{Coords}}
1;