File Coverage

blib/lib/Math/PlanePath/File.pm
Criterion Covered Total %
statement 41 108 37.9
branch 4 40 10.0
condition 1 18 5.5
subroutine 12 15 80.0
pod 7 7 100.0
total 65 188 34.5


line stmt bran cond sub pod time code
1             # Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Kevin Ryde
2              
3             # This file is part of Math-PlanePath.
4             #
5             # Math-PlanePath is free software; you can redistribute it and/or modify it
6             # under the terms of the GNU General Public License as published by the Free
7             # Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Math-PlanePath is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Math-PlanePath. If not, see .
17              
18              
19             # maybe file type for sequence of turns instead of x,y
20              
21              
22              
23             package Math::PlanePath::File;
24 1     1   887 use 5.004;
  1         3  
25 1     1   6 use strict;
  1         1  
  1         24  
26 1     1   5 use Carp 'croak';
  1         1  
  1         46  
27              
28 1     1   5 use vars '$VERSION', '@ISA';
  1         2  
  1         68  
29             $VERSION = 128;
30 1     1   675 use Math::PlanePath;
  1         3  
  1         50  
31             @ISA = ('Math::PlanePath');
32              
33             use Math::PlanePath::Base::Generic
34 1         170 'round_nearest',
35 1     1   6 'is_infinite';
  1         2  
36              
37             # uncomment this to run the ### lines
38             #use Devel::Comments;
39              
40              
41             sub n_start {
42 1     1 1 5 my ($self) = @_;
43 1 50       4 if (ref $self) {
44 1         3 _read($self);
45             }
46 1         5 return $self->SUPER::n_start;
47             }
48 1     1 1 3 sub x_negative { return _read($_[0])->{'x_negative'} }
49 1     1 1 3 sub y_negative { return _read($_[0])->{'y_negative'} }
50 0     0 1 0 sub figure { return _read($_[0])->{'figure'} }
51              
52 1         933 use constant parameter_info_array =>
53             [ { name => 'filename',
54             display => 'Filename',
55             type => 'filename',
56             width => 40,
57             default => '',
58             description => 'File name to read.',
59 1     1   8 } ];
  1         1  
60              
61             sub n_to_xy {
62 0     0 1 0 my ($self, $n) = @_;
63 0 0       0 if ($n < $self->{'n_start'}) {
64 0         0 return;
65             }
66 0 0       0 if (is_infinite($n)) {
67 0         0 return;
68             }
69 0 0       0 if (defined (my $x = _read($self)->{'x_array'}->[$n])) {
70 0         0 return ($x, $self->{'y_array'}->[$n]);
71             }
72 0         0 return;
73             }
74              
75             sub xy_to_n {
76 0     0 1 0 my ($self, $x, $y) = @_;
77              
78             # lazy xy_hash creation
79 0 0       0 if (! defined $self->{'xy_hash'}) {
80 0         0 my %xy_hash;
81 0         0 _read($self)->{'xy_hash'} = \%xy_hash;
82 0         0 my $x_array = $self->{'x_array'};
83 0         0 my $y_array = $self->{'y_array'};
84 0         0 for (my $n = 0; $n <= $#$x_array; $n++) {
85 0 0       0 if (defined (my $nx = $x_array->[$n])) {
86 0         0 $xy_hash{"$nx,$y_array->[$n]"} = $n;
87              
88             # && $nx == int($nx)
89             # if ($ny == int($ny)) {
90             # }
91             }
92             }
93             }
94              
95             {
96 0 0       0 my $key = ($self->{'figure'} eq 'square'
  0         0  
97             ? round_nearest($x).','.round_nearest($y)
98             : "$x,$y");
99 0 0       0 if (defined (my $n = _read($self)->{'xy_hash'}->{$key})) {
100 0         0 return $n;
101             }
102             }
103              
104 0         0 my $x_array = $self->{'x_array'};
105 0         0 my $y_array = $self->{'y_array'};
106 0         0 for (my $n = 0; $n <= $#$x_array; $n++) {
107 0 0       0 defined (my $nx = $x_array->[$n]) or next;
108 0         0 my $ny = $y_array->[$n];
109 0 0       0 if (($x-$nx)**2 + ($y-$ny)**2 <= .25) {
110 0         0 return $n;
111             }
112             }
113 0         0 return undef;
114             }
115              
116             # exact
117             sub rect_to_n_range {
118 1     1 1 2 my ($self) = @_;
119 1         3 _read($self);
120 1         3 return ($self->{'n_start'}, $self->{'n_last'});
121             }
122              
123             my $num = "-?(?:\\.[0-9]+|[0-9]+(?:\\.[0-9]*)?)(?:[eE]-?[0-9]+)?";
124              
125             sub _read {
126 4     4   7 my ($self) = @_;
127 4 100       13 if (defined $self->{'n_start'}) {
128 3         10 return $self;
129             }
130              
131 1         2 my $n = 1;
132 1         1 $self->{'n_start'} = $n;
133 1         3 $self->{'n_last'} = $n-1; # default no range
134 1         1 $self->{'x_negative'} = 0;
135 1         2 $self->{'y_negative'} = 0;
136 1         3 $self->{'figure'} = 'square';
137              
138 1         2 my $filename = $self->{'filename'};
139 1 50 33     4 if (! defined $filename || $filename =~ /^\s*$/) {
140 1         2 return $self;
141             }
142 0           my $fh;
143 0 0         ($] >= 5.006
    0          
144             ? open $fh, '<', $filename
145             : open $fh, "< $filename")
146             or croak "Cannot open ",$filename,": ",$!;
147              
148 0           my $n_start;
149             my @x_array;
150 0           my @y_array;
151 0           my $x_negative = 0;
152 0           my $y_negative = 0;
153 0           my $any_frac = 0;
154 0           while (my $line = <$fh>) {
155 0 0         $line =~ /^\s*-?\.?[0-9]/
156             or next;
157             $line =~ /^\s*($num)[ \t,]+($num)([ \t,]+($num))?/o
158 0 0         or do {
159 0           warn $filename,':',$.,": File unrecognised line: ",$line;
160 0           next;
161             };
162 0           my ($x,$y);
163 0 0         if (defined $4) {
164 0           $n = $1;
165 0           $x = $2;
166 0           $y = $4;
167             } else {
168 0           $x = $1;
169 0           $y = $2;
170             }
171 0           $x_array[$n] = $x;
172 0           $y_array[$n] = $y;
173 0   0       $x_negative ||= ($x < 0);
174 0   0       $y_negative ||= ($y < 0);
175 0   0       $any_frac ||= ($x != int($x) || $y != int($y));
      0        
176 0 0 0       if (! defined $n_start || $n < $n_start) { $n_start = $n; }
  0            
177             ### $x
178             ### $y
179 0           $n++;
180             }
181              
182 0 0         close $fh
183             or croak "Error closing ",$filename,": ",$!;
184              
185 0           $self->{'x_array'} = \@x_array;
186 0           $self->{'y_array'} = \@y_array;
187 0           $self->{'x_negative'} = $x_negative;
188 0           $self->{'y_negative'} = $y_negative;
189 0           $self->{'n_start'} = $n_start;
190 0           $self->{'n_last'} = $#x_array; # last n index
191 0 0         if ($any_frac) { $self->{'figure'} = 'circle' }
  0            
192 0           return $self;
193             }
194              
195             1;
196             __END__