File Coverage

blib/lib/Logic/TruthTable.pm
Criterion Covered Total %
statement 221 240 92.0
branch 29 48 60.4
condition 24 46 52.1
subroutine 22 22 100.0
pod 8 10 80.0
total 304 366 83.0


line stmt bran cond sub pod time code
1             package Logic::TruthTable;
2              
3 13     13   598504 use 5.016001;
  13         140  
4 13     13   72 use strict;
  13         21  
  13         333  
5 13     13   92 use warnings;
  13         25  
  13         404  
6              
7 13     13   7699 use Moose;
  13         6123800  
  13         92  
8 13     13   99180 use Moose::Util::TypeConstraints;
  13         34  
  13         119  
9 13     13   38363 use namespace::autoclean;
  13         106300  
  13         54  
10              
11 13     13   837 use Carp;
  13         36  
  13         871  
12 13     13   92 use Module::Runtime qw(is_module_name use_module);
  13         40  
  13         91  
13 13     13   10478 use Text::CSV;
  13         269685  
  13         675  
14 13     13   8545 use JSON;
  13         129242  
  13         88  
15              
16 13     13   8183 use Logic::Minimizer;
  13         2173557  
  13         772  
17 13     13   7761 use Logic::TruthTable::Convert81 qw(:all);
  13         48  
  13         38267  
18              
19              
20             #
21             #use Devel::Timer;
22             # TBD: Parallelize the column-solving. Some
23             # recommended modules below, choose later.
24             #
25             #use Parallel::ForkManager;
26             # or
27             #use Parallel::Loops;
28             # or
29             #use MCE;
30             #use Smart::Comments ('###');
31             #
32              
33             #
34             # Base class of the Algorithm::<minimizer_name> modules
35             # which will become the columns' array type.
36             #
37             class_type 'ColumnMinimizer',
38             {class => 'Logic::Minimizer'};
39              
40             #
41             # Define types of 'array of column' and 'array of hashref',
42             # used to define our table's function columns.
43             #
44             subtype 'ArrayRefOfColumnMinimizer',
45             as 'ArrayRef[ColumnMinimizer]';
46              
47             subtype 'ArrayRefOfHashRef',
48             as 'ArrayRef[HashRef]';
49              
50             #
51             # The width attribute is fed into the
52             # minimizer object; it cannot be overridden
53             # by the minimizer's attributes.
54             #
55             has 'width' => (
56             isa => 'Int', is => 'ro', required => 1
57             );
58              
59             #
60             # The don't-care character, vars, and functions attributes on the
61             # other hand, are merely defaults and *can* be overridden
62             # by the object.
63             #
64             has 'dc' => (
65             isa => 'Str', is => 'rw',
66             default => '-'
67             );
68              
69             has 'vars' => (
70             isa => 'ArrayRef[Str]', is => 'rw', required => 0,
71             default => sub{['A' .. 'Z'];},
72             );
73              
74             has 'functions' => (
75             isa => 'ArrayRef[Str]', is => 'rw', required => 0,
76             default => sub{['F0' .. 'F9', 'F10' .. 'F31'];},
77             );
78              
79             #
80             # Used to determine which minimizer object type will be
81             # created by default for the columns. As of this release,
82             # only Algorithm::QuineMcCluskey is available, so that is
83             # the default.
84             #
85             has 'algorithm' => (
86             isa => 'Str', is => 'ro', required => 0,
87             default => 'QuineMcCluskey',
88             );
89              
90             #
91             # The column objects. Either the array ref of hash refs (i.e., the plain
92             # text), or the algorithm object.
93             #
94             has 'columns' => (
95             isa => 'ArrayRefOfHashRef|ArrayRefOfColumnMinimizer',
96             is => 'ro', required => 1,
97             reader => '_get_columns',
98             writer => '_set_columns',
99             predicate => 'has_columns'
100             );
101              
102             #
103             # The title of the truth table.
104             #
105             has 'title' => (
106             isa => 'Str', is => 'rw', required => 0,
107             predicate => 'has_title'
108             );
109              
110             #
111             # Number of columns (functions). Stored so that we don't have to
112             # go nuts with array sizing an array reference in an object.
113             #
114             has '_fn_width' => (
115             isa => 'Int', is => 'rw', required => 0
116             );
117              
118             #
119             # Hash look-up by name instead of by index for column (function)
120             # or var column.
121             #
122             has ['_fn_lookup', '_var_lookup'] => (
123             isa => 'HashRef', is => 'rw', required => 0,
124             );
125              
126             =head1 NAME
127              
128             Logic::TruthTable - Create and solve sets of boolean equations.
129              
130             =head1 VERSION
131              
132             Version 1.01
133              
134             =cut
135              
136             our $VERSION = '1.01';
137              
138              
139             =head1 SYNOPSIS
140              
141             Create a truth table.
142              
143             #
144             # Create a truth table for converting zero to nine (binary)
145             # to a 2-4-2-1 code.
146             #
147             my $tt_2421 = Logic::TruthTable->new(
148             width => 4,
149             algorithm => 'QuineMcCluskey',
150             title => "A four-bit binary to 2-4-2-1 converter",
151             vars => ['w' .. 'z'],
152             functions => [qw(a3 a2 a1 a0)],
153             columns => [
154             {
155             title => "Column a3",
156             minterms => [ 5 .. 9 ],
157             dontcares => [ 10 .. 15 ],
158             },
159             {
160             title => "Column a2",
161             minterms => [ 4, 6 .. 9 ],
162             dontcares => [ 10 .. 15 ],
163             },
164             {
165             title => "Column a1",
166             minterms => [ 2, 3, 5, 8, 9 ],
167             dontcares => [ 10 .. 15 ],
168             },
169             {
170             title => "Column a0",
171             minterms => [ 1, 3, 5, 7, 9 ],
172             dontcares => [ 10 .. 15 ],
173             },
174             ],
175             );
176              
177             #
178             # Get and print the results.
179             #
180             my @solns = $tt_2421 ->solve();
181             print join("\n\n", @solns), "\n";
182              
183             #
184             # Save the truth table values as a CSV file.
185             #
186             open my $fh_csv, ">", "twofourtwoone.csv" or die "Error opening CSV file.";
187             $tt_2421 ->export_csv(write_handle => \$fh_csv);
188             close $fh_csv or warn "Error closing CSV file: $!";
189              
190             #
191             # Or save the truth table values as a JSON file.
192             #
193             open my $fh_json, ">", "twofourtwoone.json" or die "Error opening JSON file.";
194             $tt_2421 ->export_json(write_handle => \$fh_json);
195             close $fh_json or warn "Error closing JSON file: $!";
196              
197              
198             =head1 Description
199              
200             This module minimizes tables of
201             L<Boolean expressions|https://en.wikipedia.org/wiki/Boolean_algebra> using the
202             algorithms available on CPAN.
203              
204             It lets you contain related sets of problems (represented by their columns) in
205             a single object, along with the variable names, function names, and title.
206             Methods exist to import from and export to CSV and JSON files.
207              
208             =head2 Object Methods
209              
210             =head3 new()
211              
212             Create the truth table object. The attributes are:
213              
214             =over 4
215              
216             =item 'width'
217              
218             The number of variables (input columns) in the Boolean expressions.
219              
220             This is a required attribute.
221              
222             =item 'title'
223              
224             A title for the problem you are solving.
225              
226             =item 'dc'
227              
228             I<Default value: '-'>
229              
230             Change the representation of the don't-care character. The don't-care
231             character is used in the columnstring, as character in exported
232             CSV files, and internally as a place holder for eliminated variables
233             in the equation, which may be examined with other methods.
234              
235             This becomes the I<default> value of the function columns; it may be
236             individually overridden in each C<columns> attribute.
237              
238             =item 'vars'
239              
240             I<Default value: ['A' .. 'Z']>
241              
242             The variable names used to form the equation. The names will be taken from
243             the leftmost first.
244              
245             This becomes the I<default> names of the C<vars> attribute of the function
246             columns; it may be individually overridden in each C<columns> attribute.
247              
248             =item 'functions'
249              
250             I<Default value: ['F0' .. 'F9', 'F10' .. 'F31']>
251              
252             The function names of each equation.
253              
254             The function name becomes the I<default> title of the individual column
255             if the column doesn't set a title.
256              
257             =item 'algorithm'
258              
259             The default algorithm that will be used to minimize each column.
260              
261             Currently, there is only one minimizer algorithm (L</Algorithm::QuineMcCluskey>)
262             available on CPAN, and it is the default.
263              
264             The name will come from the package name, e.g., having an attribute
265             C<algorithm =E<gt> 'QuineMcCluskey'> means that the column will be minimized
266             using the package Algorithm::QuineMcCluskey.
267              
268             The algorithm module must be installed and be of the form
269             C<Algorithm::Name>. The module must also have Logic::Minimizer as its
270             parent class. This ensures that it will have the methods needed by
271             Logic::TruthTable to create and solve the Boolean expressions.
272              
273             This becomes the I<default> value of the function columns; it may be
274             individually overridden in each C<columns>'s attribute.
275              
276             =item 'columns'
277              
278             An array of hash references. Each hash reference contains the key/value
279             pairs used to define the Boolean expression. These are used to create
280             a minimizer object, which in turn solves the expression.
281              
282             =item 'minterms'
283              
284             An array reference of terms representing the 1-values of the
285             Boolean expression.
286              
287             =item 'maxterms'
288              
289             An array reference of terms representing the 0-values of the
290             Boolean expression. This will also indicate that you want the
291             expression in product-of-sum form, instead of the default
292             sum-of-product form.
293              
294             =item 'dontcares'
295              
296             An array reference of terms representing the don't-care-values of the
297             Boolean expression. These represent inputs that simply shouldn't happen
298             (e.g., numbers 11 through 15 in a base 10 system), and therefore don't
299             matter to the result.
300              
301             =item 'columnstring'
302              
303             Present the entire list of values of the boolean expression as a single
304             string. The values are ordered from left to right in the string. For example,
305             a simple two-variable AND equation would have a string "0001".
306              
307             =back
308              
309             You can use only one of C<minterms>, C<maxterms>, or C<columnstring>.
310              
311             The minterms or maxterms do not have to be created by hand; there are
312             functions in L</Logic::TruthTable::Util> to help create the terms.
313              
314             =over 4
315              
316             =item 'dc'
317              
318             Change the representation of the don't-care character. The don't-care character
319             is used both in the columnstring, and internally as a place holder for
320             eliminated variables in the equation. Defaults to the character
321             defined in the C<Logic::TruthTable> object.
322              
323             =item 'title'
324              
325             A title for the expression you are solving. Defaults to the function
326             name defined in the C<Logic::TruthTable> object.
327              
328             =item 'vars'
329              
330             I<Default value: ['A' .. 'Z']>
331              
332             The variable names used to form the equation. Defaults to the variable
333             names defined in the C<Logic::TruthTable> object.
334            
335             #
336             # Create a "Rock-Paper-Scissors winners" truth table, using
337             # the following values:
338             #
339             # Columns represent (in two bits) the winner of Rock (01)
340             # vs. Paper (10), or vs. Scissors (11). A tie is 00.
341             #
342             #
343             # a1 a0 b1 b0 || w1 w0
344             # -----------------------
345             # 0 0 0 0 0 || - -
346             # 1 0 0 0 1 || - -
347             # 2 0 0 1 0 || - -
348             # 3 0 0 1 1 || - -
349             # 4 0 1 0 0 || - -
350             # 5 0 1 0 1 || 0 0 (tie)
351             # 6 0 1 1 0 || 1 0 (paper)
352             # 7 0 1 1 1 || 0 1 (rock)
353             # 8 1 0 0 0 || - -
354             # 9 1 0 0 1 || 1 0 (paper)
355             # 10 1 0 1 0 || 0 0 (tie)
356             # 11 1 0 1 1 || 1 1 (scissors)
357             # 12 1 1 0 0 || - -
358             # 13 1 1 0 1 || 0 1 (rock)
359             # 14 1 1 1 0 || 1 1 (scissors)
360             # 15 1 1 1 1 || 0 0 (tie)
361             #
362              
363             use Logic::TruthTable;
364              
365             my $ttbl = Logic::TruthTable->new(
366             width => 4,
367             algorithm => 'QuineMcCluskey',
368             title => 'Rock Paper Scissors Winner Results',
369             vars => ['a1', 'a0', 'b1', 'b0'],
370             functions => ['w1', 'w0'],
371             columns => [
372             {
373             title => 'Bit 1 of the result.',
374             minterms => [6, 9, 11, 14],
375             dontcares => [0 .. 4, 8, 12],
376             },
377             {
378             title => 'Bit 0 of the result.',
379             minterms => [7, 11, 13, 14],
380             dontcares => [0 .. 4, 8, 12],
381             },
382             ],
383             );
384              
385              
386             =back
387              
388             Alternatively, it is possible to pre-create the algorithm minimizer objects,
389             and use them directly in the C<columns> array, although it does result in
390             a lot of duplicated code:
391              
392             my $q1 = Algorithm::QuineMcCluskey->new(
393             title => "Column 1 of RPS winner results";
394             width => 4,
395             minterms => [ 2, 3, 5, 8, 9 ],
396             dontcares => [ 10 .. 15 ],
397             vars => ['w' .. 'z'],
398             );
399             my $q0 = Algorithm::QuineMcCluskey->new(
400             title => "Column 0 of RPS winner results";
401             width => 4,
402             minterms => [ 1, 3, 5, 7, 9 ],
403             dontcares => [ 10 .. 15 ],
404             vars => ['w' .. 'z'],
405             );
406              
407             #
408             # Create the truth table using the above
409             # Algorithm::QuineMcCluskey objects.
410             #
411             my $tt_rps = Logic::TruthTable->new(
412             width => 4,
413             title => 'Rock Paper Scissors Winner Results',
414             functions => [qw(w1 w0)],
415             columns => [$q1, $q0],
416             );
417              
418             =cut
419              
420             sub BUILD
421             {
422 10     10 0 40506 my $self = shift;
423 10         344 my $w = $self->width;
424 10         24 my @cols = @{$self->_get_columns};
  10         320  
425 10         28 my @fn_names = @{$self->functions};
  10         274  
426 10         27 my @vars = @{$self->vars};
  10         281  
427 10         280 my $dc = $self->dc;
428              
429             #
430             # Make sure the number of function names and variables
431             # get set correctly.
432             #
433 10 50       46 croak "Not enough function names for your columns" if ($#fn_names < $#cols);
434              
435 10         45 $#fn_names = $#cols;
436 10         287 $self->functions(\@fn_names);
437 10         384 $self->_fn_width($#cols);
438              
439 10         45 $#vars = $w - 1;
440 10         285 $self->vars(\@vars);
441 10 100       349 $self->title("$w-variable truth table in $#cols columns") unless ($self->has_title);
442              
443             #
444             # Set up the look-up-by-name hashes.
445             #
446 10         71 $self->_fn_lookup({ map{ $fn_names[$_], $_} (0 .. $#fn_names) });
  25         418  
447 10         40 $self->_var_lookup({ map{ $vars[$_], $_} (0 .. $#vars) });
  44         425  
448              
449             #
450             # Set up the individual columns, using defaults
451             # from the truth table object, if present.
452             #
453 10         59 for my $idx (0 .. $#cols)
454             {
455 25         51 my %tcol = %{ $cols[$idx] };
  25         147  
456 25   66     195 $tcol{width} //= $w;
457              
458             croak "Column $idx: width => " . $tcol{width} .
459 25 50       94 " doesn't match table's width $w" if ($tcol{width} != $w);
460 25   66     130 $tcol{dc} //= $dc;
461 25   66     780 $tcol{algorithm} //= $self->algorithm;
462 25   100     178 $tcol{vars} //= [@vars];
463 25   66     137 $tcol{title} //= $fn_names[$idx];
464              
465 25         91 ${$self->_get_columns}[$idx] = new_minimizer_obj(\%tcol);
  25         796  
466             }
467              
468 10         94 return $self;
469             }
470              
471             #
472             # new_minimizer_obj(%algorithm_options)
473             #
474             # Creates a column's object (e.g. an Algorithm::QuineMcCluskey object)
475             # from the options provided.
476             #
477             sub new_minimizer_obj
478             {
479 25     25 0 64 my($href) = @_;
480 25         54 my %args = %{$href};
  25         123  
481 25         63 my $al;
482              
483             #
484             # Find out which object we're creating.
485             #
486 25         91 ($al = $args{algorithm}) =~ s/-/::/;
487 25         74 $al = "Algorithm::" . $al;
488              
489 25 50       125 croak "Invalid module name '$al'" unless (is_module_name($al));
490              
491 25         486 my $obj = use_module($al)->new(%args);
492 25 50       558149 croak "Couldn't create '$al' object" unless defined $obj;
493              
494 25         103 return $obj;
495             }
496              
497             =head3 solve()
498              
499             Run the columns of the truth table through their solving methods. Each column's
500             solution is returned in a list.
501              
502             A way to view the solutions would be:
503              
504             my @equations = $tt->solve();
505              
506             print join("\n", @equations), "\n";
507              
508             =cut
509              
510             sub solve
511             {
512 8     8 1 351 my $self = shift;
513              
514 8         19 return map {$_->solve()} @{$self->_get_columns};
  19         302783  
  8         263  
515             }
516              
517             =head3 fnsolve()
518              
519             Like C<solve()>, run the columns of the truth table through their solving
520             methods, but store the solutions in a hash table using each column's
521             function name as a key.
522              
523             =cut
524              
525             sub fnsolve
526             {
527 4     4 1 1349 my $self = shift;
528 4         10 my(@f) = @{ $self->functions() };
  4         131  
529 4         9 my %fn;
530              
531 4         16 $fn{shift @f} = $_ for ($self->solve());
532              
533 4         54300 return %fn;
534             }
535              
536              
537             =head3 all_solutions()
538              
539             It is possible that there's more than one equation that solves a
540             column's boolean expression. Therefore solve() can return a different
541             (but equally valid) equation on separate runs.
542              
543             If you wish to examine all the possible equations that solve an
544             individual column, you may call all_solutions using the columns name.
545              
546             print "All possible equations for column F0:\n";
547             print join("\n\t", $tt->all_solutions("F0")), "\n";
548              
549             =cut
550              
551             sub all_solutions
552             {
553 2     2 1 1373 my $self = shift;
554              
555 2 50       6 if (@_ == 0)
556             {
557 0         0 carp "No column name provided to all_solutions().";
558 0         0 return ();
559             }
560              
561 2         6 my $col = $self->fncolumn(@_);
562 2 50       11 return $col->all_solutions() if (defined $col);
563 0         0 return ();
564             }
565              
566             =head3 fncolumn()
567              
568             Return a column object by name.
569              
570             The columns of a C<Logic::TruthTable> object are themselves
571             objects, of types C<Algorithm::Name>, where I<Name> is the
572             algorithm, and which may be set using the C<algorithm> parameter
573             in C<new()>. (As of this writing, the only algorithm availble
574             in the CPAN ecosystem is C<Algorithm::QuineMcCluseky>.)
575              
576             Each column is named via the C<functions> attribute in C<new()>, and
577             a column can be retrieved using its name.
578              
579             my $ttable = Logic::TruthTable->new(
580             title => "An Example",
581             width => 5,
582             functions => ['F1', 'F0'],
583             columns => [
584             {
585             minterms => [6, 9, 23, 27],
586             dontcares => [0, 2, 4, 16, 24],
587             },
588             {
589             minterms => [7, 11, 19, 23, 29, 30],
590             dontcares => [0, 2, 4, 16, 24],
591             },
592             ],
593             );
594              
595             my $col_f0 = $ttable->fncolumn('F0');
596              
597             C<$col_f0> will be an Algorithm::QuineMcCluskey object with minterms
598             (7, 11, 19, 23, 29, 30).
599              
600             =cut
601              
602             sub fncolumn
603             {
604 10     10 1 3864 my $self = shift;
605 10         23 my($fn_name) = @_;
606 10         15 my $idx;
607              
608             #
609             #### Let's look at the key: $fn_name
610             #### Let's look at the hash: %{$self->_fn_lookup()}
611             #### Let's look an an element: $self->_fn_lookup()->{$fn_name}
612             #
613              
614 10         19 $idx = %{$self->_fn_lookup()}{$fn_name};
  10         309  
615              
616 10 50       35 return undef unless (defined $idx);
617 10         15 return ${$self->_get_columns}[$idx];
  10         289  
618              
619             }
620              
621             =head3 export_csv()
622              
623             =head3 export_json()
624              
625             Write the truth table out as either a CSV file or a JSON file.
626              
627             In either case, the calling code opens the file and provides the file
628             handle:
629              
630             open my $fh_nq, ">:encoding(utf8)", "nq_6.json"
631             or die "Can't open export file: $!";
632              
633             $tt->export_json(write_handle => $fh_nq);
634              
635             close $fh_nq or warn "Error closing JSON file: $!";
636              
637             Making your code handle the opening and closing of the file may
638             seem like an unnecessary inconvenience, but one benefit is that it
639             allows you to make use of STDOUT:
640              
641             $tt->export_csv(write_handle => \*STDOUT, dc => 'X');
642              
643             A CSV file can store the varible names, function names, minterms,
644             maxterms, and don't-care terms. The don't-care character of the object
645             may be overridden with your own choice by using the C<dc> parameter.
646             Whether the truth table uses minterms or maxterms will have to be a
647             choice made when importing the file (see L</import_csv()>).
648              
649             CSV is a suitable format for reading by other programs, such as spreadsheets,
650             or the program L<Logic Friday|http://sontrak.com/>, a tool for working with
651             logic functions.
652              
653             In the example below, a file is being written out for reading
654             by Logic Friday. Note that Logic Friday insists on its own
655             don't-care character, which we can set with the 'dc' option:
656              
657             if (open my $fh_mwc, ">", "ttmwc.csv")
658             {
659             #
660             # Override the don't-care character, as Logic Friday
661             # insists on it being an 'X'.
662             #
663             $truthtable->export_csv(write_handle => $fh_mwc, dc => 'X');
664              
665             close $fh_mwc or warn "Error closing CSV file: $!";
666             }
667             else
668             {
669             warn "Error opening CSV file: $!";
670             }
671              
672              
673             The JSON file will store all of the attributes that were in the
674             truth table, except for the algorithm, which will have to be
675             set when importing the file.
676              
677             The options are:
678              
679             =over 2
680              
681             =item write_handle
682              
683             The opened file handle for writing.
684              
685             =item dc
686              
687             The don't-care symbol to use in the file. In the case of the CSV file,
688             becomes the character to write out. In the case of the JSON file, will
689             become the truth table's default character.
690              
691             =back
692              
693             The method returns undef if an error is encountered. On
694             success it returns the truth table object.
695              
696             =cut
697              
698             sub export_csv
699             {
700 1     1 1 1415 my $self = shift;
701 1         6 my(%opts) = @_;
702              
703 1         3 my $handle = $opts{write_handle};
704              
705             ### handle: $handle
706              
707 1 50       5 unless (defined $handle)
708             {
709 0         0 carp "export_csv(): no file opened for export.";
710 0         0 return undef;
711             }
712              
713 1         37 my $w = $self->width;
714 1   33     5 my $dc = $opts{dc} // $self->dc;
715 1         4 my $fmt = "%0${w}b";
716 1         3 my $lastrow = (1 << $w) - 1;
717 1         2 my @columns;
718              
719             #
720             # Set up the array of column strings.
721             #
722             # If the don't-care character is different from the
723             # don't-care character of the columns, convert them.
724             #
725             ### dc: $dc
726             #
727 1         37 for my $c_idx (0 .. $self->_fn_width)
728             {
729 2         4 my $obj = ${$self->_get_columns}[$c_idx];
  2         58  
730 2         5 my @c = @{$obj->to_columnlist};
  2         89  
731              
732 2 50       960 if ($dc ne $obj->dc)
733             {
734 2         42 $_ =~ s/[^01]/$dc/ for (@c);
735             }
736              
737 2         12 push @columns, [@c];
738             }
739              
740             #
741             # Open the CSV file, print out the header, then each row.
742             #
743 1         22 my $csv = Text::CSV->new( {binary => 1, eol => "\012"} );
744              
745 1 50       214 unless ($csv)
746             {
747 0         0 carp "Cannot use Text::CSV: " . Text::CSV->error_diag();
748 0         0 return undef;
749             }
750              
751 1         2 $csv->print($handle, [@{$self->vars}, '', @{$self->functions}]);
  1         64  
  1         27  
752              
753 1         83 for my $r_idx (0 .. $lastrow)
754             {
755 16         403 my @row = (split(//, sprintf($fmt, $r_idx)), '');
756              
757 16         518 push @row, shift @{ $columns[$_] } for (0 .. $self->_fn_width);
  32         72  
758              
759 16         107 $csv->print($handle, [@row]);
760             }
761              
762 1         38 return $self;
763             }
764              
765             sub export_json
766             {
767 1     1 1 1054 my $self = shift;
768 1         5 my(%opts) = @_;
769              
770 1         3 my $handle = $opts{write_handle};
771 1         3 my %jhash;
772             my @columns;
773              
774 1         37 $jhash{title} = $self->title;
775 1         27 $jhash{vars} = $self->vars;
776 1         28 $jhash{functions} = $self->functions;
777 1         27 $jhash{width} = $self->width;
778 1   33     7 $jhash{dc} = $opts{dc} // $self->dc;
779 1         3 for my $f (@{ $self->functions })
  1         26  
780             {
781 2         4 my %colhash;
782 2         8 my $col = $self->fncolumn($f);
783 2         60 my $isminterms = $col->has_minterms;
784 2 50       69 my $terms = $isminterms? $col->minterms: $col->maxterms;
785              
786 2 50 33     70 $colhash{dc} = $col->dc if ($col->dc ne $self->dc and $col->dc ne $jhash{dc});
787              
788 2         110 $colhash{title} = $col->title;
789             $colhash{pack81} =
790 2         72 terms_to_base81($self->width, $isminterms,
791             $terms, $col->dontcares);
792 2         198 push @columns, {%colhash};
793             }
794 1         14 $jhash{columns} = \@columns;
795 1         27 my $jstr = encode_json(\%jhash);
796 1         7 print $handle $jstr;
797 1         6 return $self;
798             }
799              
800             =head3 import_csv()
801              
802             =head3 import_json()
803              
804             Read a previously written CSV or JSON file and create a Logic::TruthTable
805             object from it.
806              
807             #
808             # Read in a JSON file.
809             #
810             if (open my $fh_x3, "<:encoding(utf8)", "excess_3.json")
811             {
812             $truthtable = Logic::TruthTable->import_json(
813             read_handle => $fh_x3,
814             algorithm => $algorithm,
815             );
816             close $fh_x3 or warn "Error closing JSON file: $!";
817             }
818              
819              
820             #
821             # Read in a CSV file.
822             #
823             if (open my $lf, "<", "excess_3.csv")
824             {
825             $truthtable = Logic::TruthTable->import_csv(
826             read_handle => $lf,
827             dc => '-',
828             algorithm => $algorithm,
829             title => 'Four bit Excess-3 table',
830             termtype => 'minterms',
831             );
832             close $lf or warn "Error closing CSV file: $!";
833             }
834              
835             Making your code handle the opening and closing of the file may
836             seem like an unnecessary inconvenience, but one benefit is that it
837             allows you to make use of STDIN or the __DATA__ section:
838              
839             my $ttable = Logic::TruthTable->import_csv(
840             title => "Table created from __DATA__ section.",
841             read_handle => \*DATA,
842             );
843             print $ttable->fnsolve();
844             exit(0);
845             __DATA__
846             c2,c1,c0,,w1,w0
847             0,0,0,,X,0
848             0,0,1,,X,X
849             0,1,0,,X,X
850             0,1,1,,X,1
851             1,0,0,,X,X
852             1,0,1,,0,X
853             1,1,0,,1,1
854             1,1,1,,0,1
855              
856             The attributes read in may be set or overridden, as the file may not
857             have the attributes that you want. CSV files in particular do not have a
858             title or termtype, and without the C<dc> option the truth table's
859             don't-care character will be the object's default character, not what was
860             stored in the file.
861              
862             You can set whether the truth table object is created using its
863             minterms or its maxterms by using the C<termtype> attribute:
864              
865             $truthtable = Logic::TruthTable->import_csv(
866             read_handle => $lf,
867             termtype => 'maxterms', # or 'minterms'.
868             );
869              
870             By default the truth table is created with minterms.
871              
872             In addition to the termtype, you may also set the title, don't-care character,
873             and algorithm attributes. Width, variable names, and function names cannot be
874             set as these are read from the file.
875              
876             $truthtable = Logic::TruthTable->import_json(
877             read_handle => $fh_x3,
878             title => "Excess-3 multiplier",
879             dc => '.',
880             algorithm => 'QuineMcCluskey'
881             );
882              
883             The options are:
884              
885             =over 2
886              
887             =item read_handle
888              
889             The opened file handle for reading.
890              
891             =item dc
892              
893             The don't-care symbol to use in the truth table. In the case of the CSV
894             file, becomes the default character of the table and its columns. In the
895             case of the JSON file, becomes the truth table's default character, but may
896             not be an individual column's character if it already has a value set.
897              
898             =item algorithm
899              
900             The truth table's algorithm of choice. The algorthm's module must be one
901             that is intalled, or the truth table object will fail to build.
902              
903             =item title
904              
905             The title of the truth table.
906              
907             =item termtype
908              
909             The terms to use when creating the columns. May be either C<minterms>
910             (the default) or C<maxterms>.
911              
912             =back
913              
914             The method returns undef if an error is encountered.
915              
916             =cut
917              
918             sub import_csv
919             {
920 1     1 1 97 my $self = shift;
921 1         5 my(%opts) = @_;
922              
923 1         3 my $handle = $opts{read_handle};
924 1   50     8 my $termtype = $opts{termtype} // 'minterms';
925              
926 1         2 my @vars;
927             my @functions;
928 1         3 my $width = 0;
929              
930 1 50       3 unless (defined $handle)
931             {
932 0         0 carp "import_csv(): no file opened.";
933 0         0 return undef;
934             }
935 1 50       8 unless ($termtype =~ /minterms|maxterms/)
936             {
937 0         0 carp "Incorrect value for termtype ('minterms' or 'maxterms')";
938 0         0 return undef;
939             }
940              
941 1         8 my $csv = Text::CSV->new( {binary => 1} );
942              
943 1 50       218 unless ($csv)
944             {
945 0         0 carp "Cannot use Text::CSV: " . Text::CSV->error_diag();
946 0         0 return undef;
947             }
948              
949             #
950             # Parse the first line of the file, which is the header,
951             # and which will have the variable and function names, which
952             # in turn will let us deduce the width.
953             #
954 1         47 my $header = $csv->getline($handle);
955              
956             #
957             ### The header is: $header
958             #
959 1         38 for (@$header)
960             {
961             #
962             ### Examining: $_
963             #
964 7 100       16 if ($_ eq '')
    100          
965             {
966 1 50       4 if ($width != 0)
967             {
968 0         0 carp "File is not in the correct format";
969 0         0 return undef;
970             }
971              
972 1         3 $width = scalar @vars;
973             }
974             elsif ($width == 0)
975             {
976 4         9 push @vars, $_;
977             }
978             else
979             {
980 2         4 push @functions, $_;
981             }
982             }
983              
984             #
985             # Now that we've got our width, var names, and
986             # function names, collect the terms.
987             #
988             ### width: $width
989             ### termtype: $termtype
990             ### functions: @functions
991             ### vars: @vars
992             #
993 1         2 my($termrefs, $dcrefs);
994              
995 1         3 my $idx = 0;
996 1         21 while (my $row = $csv->getline($handle))
997             {
998 16         430 for my $c (0 .. $#functions)
999             {
1000 32         49 my $field = 1 + $c + $width;
1001              
1002 32 100 66     163 if ($row->[$field] !~ /[01]/)
    100 33        
      66        
1003             {
1004 14         19 push @{ $dcrefs->[$c] }, $idx;
  14         30  
1005             }
1006             elsif (($termtype eq 'minterms' and $row->[$field] eq '1') or
1007             ($termtype eq 'maxterms' and $row->[$field] eq '0'))
1008             {
1009 8         13 push @{ $termrefs->[$c] }, $idx;
  8         18  
1010             }
1011             }
1012 16         311 $idx++;
1013             }
1014              
1015             #
1016             # We've collected our variable names, function names, and terms.
1017             # Let's make an object.
1018             #
1019             ### dcrefs: $dcrefs
1020             ### termrefs: $termrefs
1021             #
1022 1   33     48 my $title = $opts{title} // "$width-input table created from import file";
1023 1   50     6 my $algorithm = $opts{algorithm} // 'QuineMcCluskey';
1024 1   50     5 my $dc = $opts{dc} // '-';
1025 1         2 my @columns;
1026              
1027 1         3 for my $c (0 .. $#functions)
1028             {
1029 2         7 push @columns, {
1030             dontcares => $dcrefs->[$c],
1031             $termtype, $termrefs->[$c]
1032             };
1033             }
1034              
1035 1         16 return Logic::TruthTable->new(
1036             width => $width,
1037             title => $title,
1038             dc => $dc,
1039             vars => [@vars],
1040             functions => [@functions],
1041             columns => [@columns],
1042             algorithm => $algorithm,
1043             );
1044             }
1045              
1046             sub import_json
1047             {
1048 1     1 1 111 my $self = shift;
1049 1         5 my(%opts) = @_;
1050              
1051 1         2 my $handle = $opts{read_handle};
1052 1   50     8 my $termtype = $opts{termtype} // 'minterms';
1053              
1054 1 50       4 unless (defined $handle)
1055             {
1056 0         0 carp "import_json(): no file opened.";
1057 0         0 return undef;
1058             }
1059              
1060             #
1061             # The attributes that may be overridden by the function's caller.
1062             #
1063 1         4 my @opt_atts = qw(algorithm title dc);
1064              
1065             #
1066             # Slurp in the entire JSON string.
1067             #
1068 1         2 my $jstr = do {
1069 1         4 local $/ = undef;
1070 1         23 <$handle>;
1071             };
1072              
1073             #
1074             # Take the JSON string and parse it.
1075             #
1076             ### JSON string read in: $jstr
1077             #
1078 1         3 my %jhash = %{ decode_json($jstr) };
  1         20  
1079              
1080 1         5 my $width = $jhash{width};
1081 1         2 my @vars = @{ $jhash{vars} };
  1         4  
1082 1         2 my @functions = @{ $jhash{functions} };
  1         3  
1083 1         2 my @jcols = @{ $jhash{columns} };
  1         3  
1084              
1085             #
1086             # Use JSON, or passed-in, or default attributes?
1087             #
1088 1         3 map{$jhash{$_} = $opts{$_}} grep{exists $opts{$_}} @opt_atts;
  0         0  
  3         8  
1089              
1090 1         3 my %other = map{$_, $jhash{$_}} grep{exists $jhash{$_}} @opt_atts;
  2         8  
  3         7  
1091              
1092 1         2 my @columns;
1093             #
1094             # Go through the columns array of the JSON import.
1095             #
1096             ### columns : @jcols
1097             #
1098 1         5 for my $c (0 .. $#functions)
1099             {
1100 2         5 my $base81str = $jcols[$c]->{pack81};
1101 2         8 my($minref, $maxref, $dontcaresref) =
1102             terms_from_base81($width, $base81str);
1103              
1104 2         7 my %colhash = map{$_, $jcols[$c]->{$_}}
1105 2         6 grep{exists $jcols[$c]->{$_}} @opt_atts;
  6         13  
1106              
1107 2 50 33     9 if (exists $jcols[$c]->{termtype} and
1108             $jcols[$c]->{termtype} eq 'maxterms')
1109             {
1110 0         0 $colhash{maxterms} = $maxref;
1111             }
1112             else
1113             {
1114 2         5 $colhash{minterms} = $minref;
1115             }
1116 2 50       3 $colhash{dontcares} = $dontcaresref if (scalar @{$dontcaresref} > 0);
  2         6  
1117              
1118 2         12 push @columns, {%colhash};
1119             }
1120              
1121 1         15 return Logic::TruthTable->new(
1122             width => $width,
1123             %other,
1124             vars => [@vars],
1125             functions => [@functions],
1126             columns => [@columns],
1127             );
1128             }
1129              
1130              
1131             =head1 AUTHOR
1132              
1133             John M. Gamble, C<< <jgamble at cpan.org> >>
1134              
1135             =head1 BUGS
1136              
1137             Please report any bugs or feature requests to C<bug-logic-truthtable at rt.cpan.org>,
1138             or through the web interface at
1139             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Logic-TruthTable>. I will
1140             be notified, and then you'll automatically be notified of progress on your
1141             bug as I make changes.
1142              
1143             =head1 SUPPORT
1144              
1145             This module is on Github at L<https://github.com/jgamble/Logic-TruthTable>
1146              
1147             You can also look for information on L<MetaCPAN|https://metacpan.org/release/Logic-TruthTable>
1148              
1149             =head1 SEE ALSO
1150              
1151             =over 3
1152              
1153             =item
1154              
1155             Introduction To Logic Design, by Sajjan G. Shiva, 1998.
1156              
1157             =item
1158              
1159             Discrete Mathematics and its Applications, by Kenneth H. Rosen, 1995
1160              
1161             =item
1162              
1163             L<Logic Friday|https://web.archive.org/web/20180204131842/http://sontrak.com/>
1164             ("Free software for boolean logic optimization, analysis, and synthesis.")
1165             was located on its website until some time after 4 February 2018, at which
1166             point it shut down. It was enormously useful, and can still be found on
1167             The Wayback Machine.
1168              
1169             It has two forms of its export format, a standard CSV file, and a minimized
1170             version of the CSV file that unfortunately was not documented. This is
1171             why only the standard CSV file can be read or written.
1172              
1173             =back
1174              
1175             =head1 LICENSE AND COPYRIGHT
1176              
1177             Copyright (c) 2019 John M. Gamble. All rights reserved. This program is
1178             free software; you can redistribute it and/or modify it under the same
1179             terms as Perl itself.
1180              
1181             See L<http://dev.perl.org/licenses/> for more information.
1182              
1183             =cut
1184              
1185             1;
1186              
1187             __END__