"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Graphics/TriD/TriD/MathGraph.pm" between
PDL-2.077.tar.gz and PDL-2.078.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

MathGraph.pm  (PDL-2.077)	:	MathGraph.pm  (PDL-2.078)
skipping to change at line 35		skipping to change at line 35
conditions. For details, see the file COPYING in the PDL		conditions. For details, see the file COPYING in the PDL
distribution. If this file is separated from the PDL distribution,		distribution. If this file is separated from the PDL distribution,
the copyright notice should be included in the file.		the copyright notice should be included in the file.
=cut		=cut
package PDL::Graphics::TriD::MathGraph;		package PDL::Graphics::TriD::MathGraph;
use strict;		use strict;
use warnings;		use warnings;
use base qw/PDL::Graphics::TriD::GObject/;		use base qw/PDL::Graphics::TriD::GObject/;
use fields qw/ArrowLen ArrowWidth/;
use OpenGL qw(:all);		use OpenGL qw(:all);
use PDL::Graphics::OpenGL::Perl::OpenGL;		use PDL::Graphics::OpenGL::Perl::OpenGL;
sub gdraw {		sub gdraw {
my($this,$points) = @_;		my($this,$points) = @_;
glDisable(&GL_LIGHTING);		glDisable(&GL_LIGHTING);
# print "Color: $this->{Color} @{$this->{Color}}\n";
glColor3d(@{$this->{Options}{Color}});		glColor3d(@{$this->{Options}{Color}});
PDL::Graphics::OpenGLQ::gl_arrows($points,$this->{Options}{From},		PDL::Graphics::OpenGLQ::gl_arrows($points,@{$this->{Options}}{qw(From To
$this->{Options}{To},$this->{ArrowLen},$this->{ArrowWidth});		ArrowLen ArrowWidth)});
glEnable(&GL_LIGHTING);		glEnable(&GL_LIGHTING);
}		}
sub get_valid_options {		sub get_valid_options {
return {UseDefcols => 0,From => [],To => [],Color => [1,1,1],		return {UseDefcols => 0,From => [],To => [],Color => [1,1,1],
ArrowWidth => 0.05, ArrowLen => 0.1}		ArrowWidth => 0.02, ArrowLen => 0.1}
}		}
package PDL::GraphEvolverOLD;
our $verbose;
use PDL::LiteF;
sub new {
my($type,$nnodes) = @_;
bless {NNodes => $nnodes,Coords => 500*PDL::random(PDL->zeroes(3,$nnodes)
)},
$type;
}
sub set_links {
my($this,$from,$to,$strength) = @_;
my $cd = $this->{NNodes};
$this->{DistMult} = PDL->zeroes($cd,$cd);
my $distmult = PDL->zeroes($cd,$cd);
(my $t1 = $this->{DistMult}->index2d($from,$to)) += $strength;
(my $t2 = $this->{DistMult}->index2d($to,$from)) += $strength;
print "DM: $distmult\n" if $verbose;
}
sub set_distmult {
my($this,$mat) = @_;
$this->{DistMult} = $mat;
}
sub set_fixed {
my($this,$ind,$coord) = @_;
$this->{FInd} = $ind; $this->{FCoord} = $coord;
}
sub step {
# $verbose=1;
my($this) = @_;
my $c = $this->{Coords};
my $vecs = $c - $c->dummy(1);
my $dists = sqrt(($vecs**2)->sumover)+0.0001;
print "D: $dists\n" if $verbose;
(my $t1 = $dists->diagonal(0,1)) .= 1000000;
my $d2 = $dists ** -0.5; # inverse
my $m = $d2**4 - 2*($this->{DistMult})*($dists+5*$dists**2) + 0.00001
- 0.000001 * $dists;
print "DN: $m\n" if $verbose;
print "V: $vecs\n" if $verbose;
my $tst = 1;
$this->{Velo} -= $tst * 0.04 * (inner($m->dummy(1), $vecs->mv(1,0)));
$this->{Velo} *=
((0.96*50/(50+sqrt(($this->{Velo}**2)->sumover->dummy(0)))))**$tst;
$c += $tst * 0.05 * $this->{Velo};
(my $tmp = $c->transpose->index($this->{FInd}->dummy(0)))
.= $this->{FCoord}
if (defined $this->{FInd});
print "C: $c\n" if $verbose;
}
sub getcoords {return $_[0]{Coords}}
package PDL::GraphEvolver;		package PDL::GraphEvolver;
use PDL::Lite;		use PDL::Lite;
use PDL::Graphics::TriD::Rout ":Func";		use PDL::Graphics::TriD::Rout ":Func";
sub new {		sub new {
my($type,$nnodes) = @_;		my($type,$coords) = @_;
bless {NNodes => $nnodes,Coords => PDL::random(PDL->zeroes(3,$nnodes)),		bless {Coords => $coords,
BoxSize => 3, DMult => 5000,		BoxSize => 3, DMult => 5000,
A => -100.0, B => -5, C => -0.1, D => 0.01,		A => -100.0, B => -5, C => -0.1, D => 0.01,
M => 30, MS => 1,		M => 30, MS => 1,
},$type;		},$type;
}		}
sub set_links {		sub set_links {
my($this,$from,$to,$strength) = @_;		my($this,$from,$to,$strength) = @_;
$this->{From} = $from;		$this->{From} = $from;
$this->{To} = $to;		$this->{To} = $to;
$this->{Strength} = $strength;		$this->{Strength} = $strength;
}		}
sub set_fixed {		sub set_fixed {
my($this,$ind,$coord) = @_;		my($this,$ind,$coord) = @_;
$this->{FInd} = $ind; $this->{FCoord} = $coord;		$this->{FInd} = $ind; $this->{FCoord} = $coord;
}		}
sub step {		sub step {
# $verbose=1;
my($this) = @_;		my($this) = @_;
my $c = $this->{Coords};		my $c = $this->{Coords};
my $velr = repulse($c,@$this{qw(BoxSize DMult A B C D)});		my $velr = repulse($c,@$this{qw(BoxSize DMult A B C D)});
my $vela;		my $vela = attract($c,@$this{qw(From To Strength M MS)});
if("ARRAY" eq ref $this->{From}) {
my $ind;
for $_ (0..$#{$this->{From}}) {
$vela += attract($c,
$this->{From}[$_],
$this->{To}[$_],
$this->{Strength}[$_],$this->{M},$this->{MS});
}
} else {
$vela = attract($c,@$this{qw(From To Strength M MS)});
}
# print "V: $velr $vela\n";
my $tst = 0.10;		my $tst = 0.10;
$this->{Velo} += $tst * 0.02 * ($velr + $vela);		$this->{Velo} = ($this->{Velo}//0) + $tst * 0.02 * ($velr + $vela);
$this->{Velo} *=		$this->{Velo} *=
((0.92*50/(50+sqrt(($this->{Velo}**2)->sumover->dummy(0)))))**$tst;		((0.92*50/(50+sqrt(($this->{Velo}**2)->sumover->dummy(0)))))**$tst;
$c += $tst * 0.05 * $this->{Velo};		$c += $tst * 0.05 * $this->{Velo};
(my $tmp = $c->transpose->index($this->{FInd}->dummy(0)))		(my $tmp = $c->transpose->index($this->{FInd}->dummy(0)))
.= $this->{FCoord}		.= $this->{FCoord}
if (defined $this->{FInd});		if (defined $this->{FInd});
print "C: $c\n" if $verbose;		print "C: $c\n" if $PDL::Graphics::TriD::verbose;
}		}
sub getcoords {return $_[0]{Coords}}		sub getcoords {return $_[0]{Coords}}
1;		1;
1;
End of changes. 12 change blocks.
83 lines changed or deleted		9 lines changed or added

---