File Coverage

blib/lib/Number/Natural/SetTheory.pm
Criterion Covered Total %
statement 59 63 93.6
branch 20 30 66.6
condition 8 18 44.4
subroutine 11 11 100.0
pod 4 4 100.0
total 102 126 80.9


line stmt bran cond sub pod time code
1             package Number::Natural::SetTheory;
2              
3 5     5   111500 use 5.010;
  5         19  
  5         170  
4 5     5   5988 use boolean;
  5         26417  
  5         25  
5 5     5   6285 use JSON qw/to_json/;
  5         100067  
  5         31  
6 5     5   905 use strict;
  5         13  
  5         354  
7 5     5   5459 use utf8;
  5         55  
  5         32  
8              
9             our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
10              
11             BEGIN
12             {
13 5     5   799 $Number::Natural::SetTheory::AUTHORITY = 'cpan:TOBYINK';
14 5         11 $Number::Natural::SetTheory::VERSION = '0.004';
15            
16 5         10 @EXPORT = qw/ /;
17 5         14 @EXPORT_OK = qw/ set_is_number set_to_number number_to_set set_to_string /;
18 5         13 $EXPORT_TAGS{'all'} = \@EXPORT_OK;
19 5         232 $EXPORT_TAGS{'default'} = $EXPORT_TAGS{'standard'} = \@EXPORT;
20             }
21              
22 5     5   30 use base qw/Exporter/;
  5         10  
  5         3735  
23              
24             sub set_is_number
25             {
26 80     80 1 4312 my ($set, $number) = @_;
27 80 50       164 return undef unless int($number)==$number;
28            
29 80 0 33     182 if (!ref $set and $set =~ /^\d+$/ and int($set)==$set)
      33        
30             {
31 0 0       0 return ($set==$number) ? true : false;
32             }
33              
34 80 50       140 return undef unless ref $set eq 'ARRAY';
35            
36 80         98 my $count = scalar @$set;
37            
38 80 100       141 return false
39             if ($count != $number);
40            
41 79 100       183 return true
42             if ($count == 0);
43              
44 39         76 my %accounted_for = map { $_ => false } 0..($count - 1);
  65         181  
45            
46 39         235 foreach my $member (@$set)
47             {
48 65         187 my $number = set_to_number($member);
49            
50 65 100 66     294 if (defined $number and exists $accounted_for{$number})
51             {
52 64 50       145 if ($accounted_for{$number})
    50          
53             {
54 0         0 return false;
55             }
56             elsif (not $accounted_for{$number})
57             {
58 64         841 $accounted_for{$number} = true;
59             }
60             }
61             }
62            
63 39 100       197 if (grep { !$_ } values %accounted_for)
  65         232  
64             {
65 1         13 return false;
66             }
67            
68 38         277 return true;
69             }
70              
71             sub number_to_set
72             {
73 15     15 1 22 my ($num) = @_;
74            
75 15 50 33     106 unless ($num =~ /^\d+$/ and int($num)==$num)
76             {
77 0         0 return undef;
78             }
79            
80 15 100       45 return [] if $num==0;
81 7         15 my @set = map { number_to_set($_) } 0 .. ($num-1);
  11         27  
82 7         29 return \@set;
83             }
84              
85             sub set_to_number
86             {
87 71     71 1 91 my ($set) = @_;
88            
89 71 50 66     423 if (!ref $set and $set =~ /^\d+$/ and int($set)==$set)
      33        
90             {
91 0         0 return $set;
92             }
93            
94 71 100       144 return undef unless ref $set eq 'ARRAY';
95            
96 70 100       149 if (set_is_number($set, scalar @$set))
97             {
98 69         783 return scalar @$set;
99             }
100            
101 1         17 return undef;
102             }
103              
104             sub set_to_string
105             {
106 4     4 1 11 my ($set) = @_;
107 4         13 my $string = to_json($set);
108 4         95 $string =~ s/\[/\{/g;
109 4         13 $string =~ s/\]/\}/g;
110 4         20 return $string;
111             }
112              
113             'What exactly is zero?';
114              
115             __END__