Last active
August 29, 2015 14:16
-
-
Save jacoby/e228878745ff4e6f3fe6 to your computer and use it in GitHub Desktop.
Code to create SVG images of periodic functions for my amusement
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env perl | |
use feature qw'say' ; | |
use strict ; | |
use warnings ; | |
use utf8 ; | |
use Data::Dumper ; | |
use Getopt::Long ; | |
use SVG ; | |
use lib '/home/jacoby/lib' ; | |
use Spirograph ; | |
my $conf = { | |
height => 800 , | |
width => 800 , | |
k => 30 , | |
r => 11.5 , | |
stroke => 'black' , | |
fill => 'none' , | |
name => 'both.svg' , | |
} ; | |
GetOptions( | |
'height=i' => \$conf->{ height } , | |
'width=i' => \$conf->{ width } , | |
'k=f' => \$conf->{ k } , | |
'r=f' => \$conf->{ r } , | |
'name=s' => \$conf->{ name } , | |
) ; | |
my $svg = SVG->new( | |
height => $conf->{ height }, | |
width => $conf->{ width }, | |
) ; | |
my $grp = $svg->group( | |
id => 'group_y', | |
style => { | |
stroke => $conf->{ stroke } , | |
fill => $conf->{ fill }, | |
} | |
) ; | |
epicycloid( { | |
grp => $grp, | |
stroke => 'blue', | |
def => { | |
r => $conf->{ r }, | |
k => $conf->{ k }, | |
}, | |
center => { | |
x => $conf->{ height } / 2 , | |
y => $conf->{ width } / 2 , | |
}, | |
} | |
) ; | |
hypocycloid( { | |
grp => $grp, | |
stroke => 'red', | |
def => { | |
r => $conf->{ r }, | |
k => $conf->{ k }, | |
}, | |
center => { | |
x => $conf->{ height } / 2 , | |
y => $conf->{ width } / 2 , | |
}, | |
} | |
) ; | |
my $output = $svg->xmlify ; | |
if ( open my $fh , '>' , $conf->{ name } ) { | |
print $fh $output ; | |
close $fh ; | |
say 'Done' ; | |
} | |
else { | |
say 'fail' ; | |
} | |
exit ; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package Spirograph ; | |
use feature qw{ state say } ; | |
use strict ; | |
use warnings ; | |
use CGI ; | |
use Data::Dumper ; | |
use Exporter 'import' ; | |
use Math::Trig ; | |
use SVG ; | |
our @EXPORT ; | |
BEGIN { | |
our @EXPORT = qw{ | |
epicycloid | |
hypocycloid | |
hypotrochoid | |
} ; | |
} | |
my @range = 0 .. 50_000 ; | |
my $denom = 400 ; | |
# http://en.wikipedia.org/wiki/Epicycloid | |
# x(angle) = r( k + 1 )cos(angle) -rcos((k+1)(angle)) | |
# y(angle) = r( k + 1 )sin(angle) -rsin((k+1)(angle)) | |
sub epicycloid { | |
my $object = shift ; | |
my $grp = $object->{ grp } ; | |
my $prev = 0 ; | |
my $centXY = $object->{ center } ; | |
my $prevXY = {} ; | |
my $currXY = {} ; | |
my $o ; | |
for my $i ( qw{ k r } ) { | |
$o->{ $i } = $object->{ def }->{ $i } ; | |
} | |
for my $deg ( map { $_ / $denom } @range ) { | |
$o->{ n } = $deg ; # deg2rad( $deg ) ; | |
# epicycloid ============================================== | |
$currXY->{ x } = eXpos( $o ) ; | |
$currXY->{ y } = eYpos( $o ) ; | |
$grp->line( | |
x1 => $centXY->{ x } + $prevXY->{ x }, | |
y1 => $centXY->{ y } - $prevXY->{ y }, | |
x2 => $centXY->{ x } + $currXY->{ x }, | |
y2 => $centXY->{ y } - $currXY->{ y }, | |
style => { | |
stroke => $object->{ stroke }, | |
fill => 'none', | |
} | |
) unless $deg == $prev ; | |
$prev = $deg ; | |
$prevXY->{ x } = $currXY->{ x } ; | |
$prevXY->{ y } = $currXY->{ y } ; | |
# epicycloid ============================================== | |
} | |
} | |
sub eXpos { | |
my $obj = shift ; | |
my ( $k, $r, $n ) = map { $obj->{ $_ } } qw{ k r n } ; | |
return ( $r * ( $k + 1 ) * cos( $n ) ) - ( $r * cos( $n * ( $k + 1 ) ) ) ; | |
} | |
sub eYpos { | |
my $obj = shift ; | |
my ( $k, $r, $n ) = map { $obj->{ $_ } } qw{ k r n } ; | |
return ( $r * ( $k + 1 ) * sin( $n ) ) - ( $r * sin( $n * ( $k + 1 ) ) ) ; | |
} | |
# http://en.wikipedia.org/wiki/Hypocycloid | |
# x(angle) = r( k + 1 )cos(angle) -rcos((k+1)(angle)) | |
# y(angle) = r( k + 1 )sin(angle) -rsin((k+1)(angle)) | |
sub hypocycloid { | |
my $object = shift ; | |
my $grp = $object->{ grp } ; | |
my $prev = 0 ; | |
my $centXY = $object->{ center } ; | |
my $prevXY = {} ; | |
my $currXY = {} ; | |
my $o ; | |
for my $i ( qw{ k r } ) { | |
$o->{ $i } = $object->{ def }->{ $i } ; | |
} | |
for my $deg ( map { $_ / $denom } @range ) { | |
$o->{ n } = $deg ; # deg2rad( $deg ) ; | |
# epicycloid ============================================== | |
$currXY->{ x } = hXpos( $o ) ; | |
$currXY->{ y } = hYpos( $o ) ; | |
$grp->line( | |
x1 => $centXY->{ x } + $prevXY->{ x }, | |
y1 => $centXY->{ y } - $prevXY->{ y }, | |
x2 => $centXY->{ x } + $currXY->{ x }, | |
y2 => $centXY->{ y } - $currXY->{ y }, | |
style => { | |
stroke => $object->{ stroke }, | |
fill => 'none', | |
} | |
) unless $deg == $prev ; | |
$prev = $deg ; | |
$prevXY->{ x } = $currXY->{ x } ; | |
$prevXY->{ y } = $currXY->{ y } ; | |
# epicycloid ============================================== | |
} | |
} | |
sub hXpos { | |
my $obj = shift ; | |
my ( $k, $r, $n ) = map { $obj->{ $_ } } qw{ k r n } ; | |
return ( $r * ( $k - 1 ) * cos( $n ) ) + ( $r * cos( $n * ( $k - 1 ) ) ) ; | |
} | |
sub hYpos { | |
my $obj = shift ; | |
my ( $k, $r, $n ) = map { $obj->{ $_ } } qw{ k r n } ; | |
return ( $r * ( $k - 1 ) * sin( $n ) ) - ( $r * sin( $n * ( $k - 1 ) ) ) ; | |
} | |
# http://en.wikipedia.org/wiki/Hypotrochoid | |
# x(angle) = (R-r)cos(angle) + d cos((R-r)/R *(angle)) | |
# y(angle) = (R-r)sin(angle) + d sin((R-r)/R *(angle)) | |
sub hypotrochoid { | |
my $object = shift ; | |
my $grp = $object->{ grp } ; | |
my $prev = 0 ; | |
my $centXY = $object->{ center } ; | |
my $prevXY = {} ; | |
my $currXY = {} ; | |
my $o ; | |
for my $i ( qw{ R r d } ) { | |
$o->{ $i } = $object->{ def }->{ $i } ; | |
} | |
for my $deg ( map { $_ / $denom } @range ) { | |
$o->{ n } = $deg ; # deg2rad( $deg ) ; | |
# hypotrochoid ============================================== | |
$currXY->{ x } = htXpos( $o ) ; | |
$currXY->{ y } = htYpos( $o ) ; | |
$grp->line( | |
x1 => $centXY->{ x } + $prevXY->{ x }, | |
y1 => $centXY->{ y } - $prevXY->{ y }, | |
x2 => $centXY->{ x } + $currXY->{ x }, | |
y2 => $centXY->{ y } - $currXY->{ y }, | |
style => { | |
stroke => $object->{ stroke }, | |
fill => 'none', | |
} | |
) unless $deg == $prev ; | |
$prev = $deg ; | |
$prevXY->{ x } = $currXY->{ x } ; | |
$prevXY->{ y } = $currXY->{ y } ; | |
# hypotrochoid ============================================== | |
} | |
} | |
sub htXpos { | |
my $obj = shift ; | |
my ( $R, $r, $d, $n ) = map { $obj->{ $_ } } qw{ R r d n } ; | |
my $front = ( ( $R - $r ) * cos( $n ) ) ; | |
my $back = ( $d * cos( $n * ( $R - $r ) / $r ) ) ; | |
return $front + $back ; | |
} | |
sub htYpos { | |
my $obj = shift ; | |
my ( $R, $r, $d, $n ) = map { $obj->{ $_ } } qw{ R r d n } ; | |
my $front = ( ( $R - $r ) * sin( $n ) ) ; | |
my $back = ( $d * sin( $n * ( $R - $r ) / $r ) ) ; | |
return $front - $back ; | |
} | |
sub xPos { | |
my ( $length, $degrees ) = @_ ; | |
return ( $length * sin( deg2rad( $degrees ) ) ) ; | |
} | |
sub yPos { | |
my ( $length, $degrees ) = @_ ; | |
return ( $length * cos( deg2rad( $degrees ) ) ) ; | |
} | |
sub distance_between_2_points { | |
my ( $x1, $y1, $x2, $y2 ) = @_ ; | |
my $x = ( $x1 - $x2 )**2 ; | |
my $y = ( $y1 - $y2 )**2 ; | |
my $sqrt = sqrt( $x + $y ) ; | |
# say join "\t" , '' , map { sprintf '%.02f' , $_ } $x , $y , $sqrt ; | |
return $sqrt ; | |
} | |
1 ; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env perl | |
use feature qw'say state' ; | |
use strict ; | |
use warnings ; | |
use utf8 ; | |
use Data::Dumper ; | |
use DateTime ; | |
use Math::Trig ; | |
use SVG ; | |
use Getopt::Long ; | |
use Spirograph ; | |
my $conf = { | |
height => 1000, | |
width => 1000, | |
r1 => 50, | |
r2 => 30, | |
d => 50, | |
stroke => 'black', | |
fill => 'none', | |
} ; | |
GetOptions( | |
'height=i' => \$conf->{ height }, | |
'width=i' => \$conf->{ width }, | |
'r1=f' => \$conf->{ r1 }, | |
'r2=f' => \$conf->{ r2 }, | |
'distance=f' => \$conf->{ d }, | |
) ; | |
my $svg = SVG->new( | |
height => $conf->{ height }, | |
width => $conf->{ width }, | |
) ; | |
my $grp = $svg->group( | |
id => 'group_y', | |
style => { | |
stroke => $conf->{ stroke }, | |
fill => $conf->{ fill }, | |
} | |
) ; | |
my $test = allPass( | |
sub { return 1 }, | |
sub { my $i = shift ; return $i % 50 == 0 }, | |
) ; | |
my $max = 450 ; | |
for my $r1 ( grep { $test->( $_ ) } 1 .. $max ) { | |
my $r2 = $r1 / 3 ; | |
my $d = 150 ; | |
my $color = '#0000' . sprintf( '%02x', int( 255 / $max * $r1 ) ) ; | |
$color = 'black' ; | |
say $color ; | |
hypotrochoid( { | |
grp => $grp, | |
stroke => $color, | |
def => { | |
R => $r1, | |
r => $r2, | |
d => $d, | |
}, | |
center => { | |
x => $conf->{ height } / 2, | |
y => $conf->{ width } / 2, | |
}, | |
} | |
) ; | |
} | |
my $output = $svg->xmlify ; | |
my @Rrd = map { $conf->{ $_ } } qw{ r1 r2 d } ; | |
my $file = 'triangles.svg' ; | |
if ( open my $fh, '>', $file ) { | |
print $fh $output ; | |
close $fh ; | |
} | |
else { | |
say 'fail' ; | |
} | |
say 'done' ; | |
exit ; | |
############################################################ | |
# take an array of code refs which SHOULD return boolean values | |
# | |
# allPass returns 0 if any of the coderefs doesn't return true, | |
# else returns true. | |
# anyPass returns 1 if any of the coderefs returns true, else | |
# returns false. | |
sub allPass { | |
return 0 if !@_ ; | |
my @f = @_ ; | |
return sub { | |
for my $t ( @f ) { | |
my $r = &$t( @_ ) ; | |
return 0 unless $r >= 1; | |
} | |
return 1 ; | |
} | |
} | |
sub anyPass { | |
return 0 if !@_ ; | |
my @f = @_ ; | |
return sub { | |
for my $t ( @f ) { | |
my $r = &$t( @_ ) ; | |
return 1 if $r >= 1 ; | |
} | |
return 0 ; | |
} | |
} | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment