File Coverage

blib/lib/Logic/TruthTable.pm
Criterion Covered Total %
statement 220 239 92.0
branch 29 48 60.4
condition 24 46 52.1
subroutine 22 22 100.0
pod 8 10 80.0
total 303 365 83.0


line stmt bran cond sub pod time code
1             package Logic::TruthTable;
2              
3 13     13   600585 use 5.016001;
  13         144  
4 13     13   70 use strict;
  13         25  
  13         299  
5 13     13   99 use warnings;
  13         28  
  13         387  
6              
7 13     13   7586 use Moose;
  13         6209912  
  13         83  
8 13     13   100541 use Moose::Util::TypeConstraints;
  13         40  
  13         132  
9 13     13   38184 use namespace::autoclean;
  13         109252  
  13         67  
10              
11 13     13   858 use Carp;
  13         40  
  13         928  
12 13     13   106 use Module::Runtime qw(is_module_name use_module);
  13         38  
  13         95  
13 13     13   11109 use Text::CSV;
  13         273611  
  13         690  
14 13     13   8931 use JSON;
  13         130005  
  13         86  
15              
16 13     13   8266 use Logic::Minimizer;
  13         2193042  
  13         866  
17 13     13   8080 use Logic::TruthTable::Convert81 qw(:all);
  13         51  
  13         39013  
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.02
133              
134             =cut
135              
136             our $VERSION = '1.02';
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 40386 my $self = shift;
423 10         341 my $w = $self->width;
424 10         27 my @cols = @{$self->_get_columns};
  10         311  
425 10         26 my @fn_names = @{$self->functions};
  10         277  
426 10         27 my @vars = @{$self->vars};
  10         271  
427 10         294 my $dc = $self->dc;
428              
429             #
430             # Make sure the number of function names and variables
431             # get set correctly.
432             #
433 10 50       45 croak "Not enough function names for your columns" if ($#fn_names < $#cols);
434              
435 10         46 $#fn_names = $#cols;
436 10         278 $self->functions(\@fn_names);
437 10         387 $self->_fn_width($#cols);
438              
439 10         49 $#vars = $w - 1;
440 10         295 $self->vars(\@vars);
441 10 100       345 $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         57 $self->_fn_lookup({ map{ $fn_names[$_], $_} (0 .. $#fn_names) });
  25         390  
447 10         44 $self->_var_lookup({ map{ $vars[$_], $_} (0 .. $#vars) });
  44         419  
448              
449             #
450             # Set up the individual columns, using defaults
451             # from the truth table object, if present.
452             #
453 10         63 for my $idx (0 .. $#cols)
454             {
455 25         56 my %tcol = %{ $cols[$idx] };
  25         176  
456 25   66     204 $tcol{width} //= $w;
457              
458             croak "Column $idx: width => " . $tcol{width} .
459 25 50       86 " doesn't match table's width $w" if ($tcol{width} != $w);
460 25   66     133 $tcol{dc} //= $dc;
461 25   66     818 $tcol{algorithm} //= $self->algorithm;
462 25   100     184 $tcol{vars} //= [@vars];
463 25   66     132 $tcol{title} //= $fn_names[$idx];
464              
465 25         91 ${$self->_get_columns}[$idx] = new_minimizer_obj(\%tcol);
  25         826  
466             }
467              
468 10         72 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 60 my($href) = @_;
480 25         46 my %args = %{$href};
  25         130  
481 25         56 my $al;
482              
483             #
484             # Find out which object we're creating.
485             #
486 25         93 ($al = $args{algorithm}) =~ s/-/::/;
487 25         98 $al = "Algorithm::" . $al;
488              
489 25 50       125 croak "Invalid module name '$al'" unless (is_module_name($al));
490              
491 25         483 my $obj = use_module($al)->new(%args);
492 25 50       565646 croak "Couldn't create '$al' object" unless defined $obj;
493              
494 25         108 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 359 my $self = shift;
513              
514 8         15 return map {$_->solve()} @{$self->_get_columns};
  19         304974  
  8         266  
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 1034 my $self = shift;
528 4         11 my(@f) = @{ $self->functions() };
  4         142  
529 4         12 my %fn;
530              
531 4         15 $fn{shift @f} = $_ for ($self->solve());
532              
533 4         55474 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 1481 my $self = shift;
554              
555 2 50       8 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       10 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 3809 my $self = shift;
605 10         26 my($fn_name) = @_;
606 10         18 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             #$idx = %{$self->_fn_lookup()}{$fn_name};
615 10         323 $idx = $self->_fn_lookup()->{$fn_name};
616              
617 10 50       31 return undef unless (defined $idx);
618 10         19 return ${$self->_get_columns}[$idx];
  10         295  
619              
620             }
621              
622             =head3 export_csv()
623              
624             =head3 export_json()
625              
626             Write the truth table out as either a CSV file or a JSON file.
627              
628             In either case, the calling code opens the file and provides the file
629             handle:
630              
631             open my $fh_nq, ">:encoding(utf8)", "nq_6.json"
632             or die "Can't open export file: $!";
633              
634             $tt->export_json(write_handle => $fh_nq);
635              
636             close $fh_nq or warn "Error closing JSON file: $!";
637              
638             Making your code handle the opening and closing of the file may
639             seem like an unnecessary inconvenience, but one benefit is that it
640             allows you to make use of STDOUT:
641              
642             $tt->export_csv(write_handle => \*STDOUT, dc => 'X');
643              
644             A CSV file can store the varible names, function names, minterms,
645             maxterms, and don't-care terms. The don't-care character of the object
646             may be overridden with your own choice by using the C<dc> parameter.
647             Whether the truth table uses minterms or maxterms will have to be a
648             choice made when importing the file (see L</import_csv()>).
649              
650             CSV is a suitable format for reading by other programs, such as spreadsheets,
651             or the program L<Logic Friday|http://sontrak.com/>, a tool for working with
652             logic functions.
653              
654             In the example below, a file is being written out for reading
655             by Logic Friday. Note that Logic Friday insists on its own
656             don't-care character, which we can set with the 'dc' option:
657              
658             if (open my $fh_mwc, ">", "ttmwc.csv")
659             {
660             #
661             # Override the don't-care character, as Logic Friday
662             # insists on it being an 'X'.
663             #
664             $truthtable->export_csv(write_handle => $fh_mwc, dc => 'X');
665              
666             close $fh_mwc or warn "Error closing CSV file: $!";
667             }
668             else
669             {
670             warn "Error opening CSV file: $!";
671             }
672              
673              
674             The JSON file will store all of the attributes that were in the
675             truth table, except for the algorithm, which will have to be
676             set when importing the file.
677              
678             The options are:
679              
680             =over 2
681              
682             =item write_handle
683              
684             The opened file handle for writing.
685              
686             =item dc
687              
688             The don't-care symbol to use in the file. In the case of the CSV file,
689             becomes the character to write out. In the case of the JSON file, will
690             become the truth table's default character.
691              
692             =back
693              
694             The method returns undef if an error is encountered. On
695             success it returns the truth table object.
696              
697             =cut
698              
699             sub export_csv
700             {
701 1     1 1 1482 my $self = shift;
702 1         6 my(%opts) = @_;
703              
704 1         3 my $handle = $opts{write_handle};
705              
706             ### handle: $handle
707              
708 1 50       6 unless (defined $handle)
709             {
710 0         0 carp "export_csv(): no file opened for export.";
711 0         0 return undef;
712             }
713              
714 1         38 my $w = $self->width;
715 1   33     5 my $dc = $opts{dc} // $self->dc;
716 1         5 my $fmt = "%0${w}b";
717 1         3 my $lastrow = (1 << $w) - 1;
718 1         3 my @columns;
719              
720             #
721             # Set up the array of column strings.
722             #
723             # If the don't-care character is different from the
724             # don't-care character of the columns, convert them.
725             #
726             ### dc: $dc
727             #
728 1         31 for my $c_idx (0 .. $self->_fn_width)
729             {
730 2         4 my $obj = ${$self->_get_columns}[$c_idx];
  2         68  
731 2         4 my @c = @{$obj->to_columnlist};
  2         17  
732              
733 2 50       927 if ($dc ne $obj->dc)
734             {
735 2         40 $_ =~ s/[^01]/$dc/ for (@c);
736             }
737              
738 2         52 push @columns, [@c];
739             }
740              
741             #
742             # Open the CSV file, print out the header, then each row.
743             #
744 1         18 my $csv = Text::CSV->new( {binary => 1, eol => "\012"} );
745              
746 1 50       220 unless ($csv)
747             {
748 0         0 carp "Cannot use Text::CSV: " . Text::CSV->error_diag();
749 0         0 return undef;
750             }
751              
752 1         4 $csv->print($handle, [@{$self->vars}, '', @{$self->functions}]);
  1         33  
  1         30  
753              
754 1         78 for my $r_idx (0 .. $lastrow)
755             {
756 16         392 my @row = (split(//, sprintf($fmt, $r_idx)), '');
757              
758 16         545 push @row, shift @{ $columns[$_] } for (0 .. $self->_fn_width);
  32         70  
759              
760 16         107 $csv->print($handle, [@row]);
761             }
762              
763 1         39 return $self;
764             }
765              
766             sub export_json
767             {
768 1     1 1 1153 my $self = shift;
769 1         7 my(%opts) = @_;
770              
771 1         3 my $handle = $opts{write_handle};
772 1         3 my %jhash;
773             my @columns;
774              
775 1         38 $jhash{title} = $self->title;
776 1         26 $jhash{vars} = $self->vars;
777 1         29 $jhash{functions} = $self->functions;
778 1         27 $jhash{width} = $self->width;
779 1   33     6 $jhash{dc} = $opts{dc} // $self->dc;
780 1         3 for my $f (@{ $self->functions })
  1         26  
781             {
782 2         8 my %colhash;
783 2         9 my $col = $self->fncolumn($f);
784 2         119 my $isminterms = $col->has_minterms;
785 2 50       62 my $terms = $isminterms? $col->minterms: $col->maxterms;
786              
787 2 50 33     54 $colhash{dc} = $col->dc if ($col->dc ne $self->dc and $col->dc ne $jhash{dc});
788              
789 2         56 $colhash{title} = $col->title;
790             $colhash{pack81} =
791 2         64 terms_to_base81($self->width, $isminterms,
792             $terms, $col->dontcares);
793 2         235 push @columns, {%colhash};
794             }
795 1         8 $jhash{columns} = \@columns;
796 1         15 my $jstr = encode_json(\%jhash);
797 1         6 print $handle $jstr;
798 1         6 return $self;
799             }
800              
801             =head3 import_csv()
802              
803             =head3 import_json()
804              
805             Read a previously written CSV or JSON file and create a Logic::TruthTable
806             object from it.
807              
808             #
809             # Read in a JSON file.
810             #
811             if (open my $fh_x3, "<:encoding(utf8)", "excess_3.json")
812             {
813             $truthtable = Logic::TruthTable->import_json(
814             read_handle => $fh_x3,
815             algorithm => $algorithm,
816             );
817             close $fh_x3 or warn "Error closing JSON file: $!";
818             }
819              
820              
821             #
822             # Read in a CSV file.
823             #
824             if (open my $lf, "<", "excess_3.csv")
825             {
826             $truthtable = Logic::TruthTable->import_csv(
827             read_handle => $lf,
828             dc => '-',
829             algorithm => $algorithm,
830             title => 'Four bit Excess-3 table',
831             termtype => 'minterms',
832             );
833             close $lf or warn "Error closing CSV file: $!";
834             }
835              
836             Making your code handle the opening and closing of the file may
837             seem like an unnecessary inconvenience, but one benefit is that it
838             allows you to make use of STDIN or the __DATA__ section:
839              
840             my $ttable = Logic::TruthTable->import_csv(
841             title => "Table created from __DATA__ section.",
842             read_handle => \*DATA,
843             );
844             print $ttable->fnsolve();
845             exit(0);
846             __DATA__
847             c2,c1,c0,,w1,w0
848             0,0,0,,X,0
849             0,0,1,,X,X
850             0,1,0,,X,X
851             0,1,1,,X,1
852             1,0,0,,X,X
853             1,0,1,,0,X
854             1,1,0,,1,1
855             1,1,1,,0,1
856              
857             The attributes read in may be set or overridden, as the file may not
858             have the attributes that you want. CSV files in particular do not have a
859             title or termtype, and without the C<dc> option the truth table's
860             don't-care character will be the object's default character, not what was
861             stored in the file.
862              
863             You can set whether the truth table object is created using its
864             minterms or its maxterms by using the C<termtype> attribute:
865              
866             $truthtable = Logic::TruthTable->import_csv(
867             read_handle => $lf,
868             termtype => 'maxterms', # or 'minterms'.
869             );
870              
871             By default the truth table is created with minterms.
872              
873             In addition to the termtype, you may also set the title, don't-care character,
874             and algorithm attributes. Width, variable names, and function names cannot be
875             set as these are read from the file.
876              
877             $truthtable = Logic::TruthTable->import_json(
878             read_handle => $fh_x3,
879             title => "Excess-3 multiplier",
880             dc => '.',
881             algorithm => 'QuineMcCluskey'
882             );
883              
884             The options are:
885              
886             =over 2
887              
888             =item read_handle
889              
890             The opened file handle for reading.
891              
892             =item dc
893              
894             The don't-care symbol to use in the truth table. In the case of the CSV
895             file, becomes the default character of the table and its columns. In the
896             case of the JSON file, becomes the truth table's default character, but may
897             not be an individual column's character if it already has a value set.
898              
899             =item algorithm
900              
901             The truth table's algorithm of choice. The algorthm's module must be one
902             that is intalled, or the truth table object will fail to build.
903              
904             =item title
905              
906             The title of the truth table.
907              
908             =item termtype
909              
910             The terms to use when creating the columns. May be either C<minterms>
911             (the default) or C<maxterms>.
912              
913             =back
914              
915             The method returns undef if an error is encountered.
916              
917             =cut
918              
919             sub import_csv
920             {
921 1     1 1 108 my $self = shift;
922 1         6 my(%opts) = @_;
923              
924 1         4 my $handle = $opts{read_handle};
925 1   50     10 my $termtype = $opts{termtype} // 'minterms';
926              
927 1         4 my @vars;
928             my @functions;
929 1         4 my $width = 0;
930              
931 1 50       4 unless (defined $handle)
932             {
933 0         0 carp "import_csv(): no file opened.";
934 0         0 return undef;
935             }
936 1 50       8 unless ($termtype =~ /minterms|maxterms/)
937             {
938 0         0 carp "Incorrect value for termtype ('minterms' or 'maxterms')";
939 0         0 return undef;
940             }
941              
942 1         9 my $csv = Text::CSV->new( {binary => 1} );
943              
944 1 50       214 unless ($csv)
945             {
946 0         0 carp "Cannot use Text::CSV: " . Text::CSV->error_diag();
947 0         0 return undef;
948             }
949              
950             #
951             # Parse the first line of the file, which is the header,
952             # and which will have the variable and function names, which
953             # in turn will let us deduce the width.
954             #
955 1         51 my $header = $csv->getline($handle);
956              
957             #
958             ### The header is: $header
959             #
960 1         42 for (@$header)
961             {
962             #
963             ### Examining: $_
964             #
965 7 100       19 if ($_ eq '')
    100          
966             {
967 1 50       5 if ($width != 0)
968             {
969 0         0 carp "File is not in the correct format";
970 0         0 return undef;
971             }
972              
973 1         2 $width = scalar @vars;
974             }
975             elsif ($width == 0)
976             {
977 4         8 push @vars, $_;
978             }
979             else
980             {
981 2         5 push @functions, $_;
982             }
983             }
984              
985             #
986             # Now that we've got our width, var names, and
987             # function names, collect the terms.
988             #
989             ### width: $width
990             ### termtype: $termtype
991             ### functions: @functions
992             ### vars: @vars
993             #
994 1         2 my($termrefs, $dcrefs);
995              
996 1         3 my $idx = 0;
997 1         22 while (my $row = $csv->getline($handle))
998             {
999 16         422 for my $c (0 .. $#functions)
1000             {
1001 32         53 my $field = 1 + $c + $width;
1002              
1003 32 100 66     141 if ($row->[$field] !~ /[01]/)
    100 33        
      66        
1004             {
1005 14         20 push @{ $dcrefs->[$c] }, $idx;
  14         31  
1006             }
1007             elsif (($termtype eq 'minterms' and $row->[$field] eq '1') or
1008             ($termtype eq 'maxterms' and $row->[$field] eq '0'))
1009             {
1010 8         15 push @{ $termrefs->[$c] }, $idx;
  8         17  
1011             }
1012             }
1013 16         309 $idx++;
1014             }
1015              
1016             #
1017             # We've collected our variable names, function names, and terms.
1018             # Let's make an object.
1019             #
1020             ### dcrefs: $dcrefs
1021             ### termrefs: $termrefs
1022             #
1023 1   33     50 my $title = $opts{title} // "$width-input table created from import file";
1024 1   50     8 my $algorithm = $opts{algorithm} // 'QuineMcCluskey';
1025 1   50     8 my $dc = $opts{dc} // '-';
1026 1         3 my @columns;
1027              
1028 1         5 for my $c (0 .. $#functions)
1029             {
1030 2         9 push @columns, {
1031             dontcares => $dcrefs->[$c],
1032             $termtype, $termrefs->[$c]
1033             };
1034             }
1035              
1036 1         22 return Logic::TruthTable->new(
1037             width => $width,
1038             title => $title,
1039             dc => $dc,
1040             vars => [@vars],
1041             functions => [@functions],
1042             columns => [@columns],
1043             algorithm => $algorithm,
1044             );
1045             }
1046              
1047             sub import_json
1048             {
1049 1     1 1 103 my $self = shift;
1050 1         4 my(%opts) = @_;
1051              
1052 1         3 my $handle = $opts{read_handle};
1053 1   50     6 my $termtype = $opts{termtype} // 'minterms';
1054              
1055 1 50       4 unless (defined $handle)
1056             {
1057 0         0 carp "import_json(): no file opened.";
1058 0         0 return undef;
1059             }
1060              
1061             #
1062             # The attributes that may be overridden by the function's caller.
1063             #
1064 1         4 my @opt_atts = qw(algorithm title dc);
1065              
1066             #
1067             # Slurp in the entire JSON string.
1068             #
1069 1         2 my $jstr = do {
1070 1         4 local $/ = undef;
1071 1         24 <$handle>;
1072             };
1073              
1074             #
1075             # Take the JSON string and parse it.
1076             #
1077             ### JSON string read in: $jstr
1078             #
1079 1         3 my %jhash = %{ decode_json($jstr) };
  1         17  
1080              
1081 1         5 my $width = $jhash{width};
1082 1         3 my @vars = @{ $jhash{vars} };
  1         4  
1083 1         2 my @functions = @{ $jhash{functions} };
  1         2  
1084 1         2 my @jcols = @{ $jhash{columns} };
  1         4  
1085              
1086             #
1087             # Use JSON, or passed-in, or default attributes?
1088             #
1089 1         3 map{$jhash{$_} = $opts{$_}} grep{exists $opts{$_}} @opt_atts;
  0         0  
  3         8  
1090              
1091 1         5 my %other = map{$_, $jhash{$_}} grep{exists $jhash{$_}} @opt_atts;
  2         7  
  3         6  
1092              
1093 1         2 my @columns;
1094             #
1095             # Go through the columns array of the JSON import.
1096             #
1097             ### columns : @jcols
1098             #
1099 1         6 for my $c (0 .. $#functions)
1100             {
1101 2         6 my $base81str = $jcols[$c]->{pack81};
1102 2         8 my($minref, $maxref, $dontcaresref) =
1103             terms_from_base81($width, $base81str);
1104              
1105 2         7 my %colhash = map{$_, $jcols[$c]->{$_}}
1106 2         6 grep{exists $jcols[$c]->{$_}} @opt_atts;
  6         22  
1107              
1108 2 50 33     9 if (exists $jcols[$c]->{termtype} and
1109             $jcols[$c]->{termtype} eq 'maxterms')
1110             {
1111 0         0 $colhash{maxterms} = $maxref;
1112             }
1113             else
1114             {
1115 2         4 $colhash{minterms} = $minref;
1116             }
1117 2 50       4 $colhash{dontcares} = $dontcaresref if (scalar @{$dontcaresref} > 0);
  2         5  
1118              
1119 2         12 push @columns, {%colhash};
1120             }
1121              
1122 1         20 return Logic::TruthTable->new(
1123             width => $width,
1124             %other,
1125             vars => [@vars],
1126             functions => [@functions],
1127             columns => [@columns],
1128             );
1129             }
1130              
1131              
1132             =head1 AUTHOR
1133              
1134             John M. Gamble, C<< <jgamble at cpan.org> >>
1135              
1136             =head1 BUGS
1137              
1138             Please report any bugs or feature requests to C<bug-logic-truthtable at rt.cpan.org>,
1139             or through the web interface at
1140             L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Logic-TruthTable>. I will
1141             be notified, and then you'll automatically be notified of progress on your
1142             bug as I make changes.
1143              
1144             =head1 SUPPORT
1145              
1146             This module is on Github at L<https://github.com/jgamble/Logic-TruthTable>
1147              
1148             You can also look for information on L<MetaCPAN|https://metacpan.org/release/Logic-TruthTable>
1149              
1150             =head1 SEE ALSO
1151              
1152             =over 3
1153              
1154             =item
1155              
1156             Introduction To Logic Design, by Sajjan G. Shiva, 1998.
1157              
1158             =item
1159              
1160             Discrete Mathematics and its Applications, by Kenneth H. Rosen, 1995
1161              
1162             =item
1163              
1164             L<Logic Friday|https://web.archive.org/web/20180204131842/http://sontrak.com/>
1165             ("Free software for boolean logic optimization, analysis, and synthesis.")
1166             was located on its website until some time after 4 February 2018, at which
1167             point it shut down. It was enormously useful, and can still be found on
1168             The Wayback Machine.
1169              
1170             It has two forms of its export format, a standard CSV file, and a minimized
1171             version of the CSV file that unfortunately was not documented. This is
1172             why only the standard CSV file can be read or written.
1173              
1174             =back
1175              
1176             =head1 LICENSE AND COPYRIGHT
1177              
1178             Copyright (c) 2019 John M. Gamble. All rights reserved. This program is
1179             free software; you can redistribute it and/or modify it under the same
1180             terms as Perl itself.
1181              
1182             See L<http://dev.perl.org/licenses/> for more information.
1183              
1184             =cut
1185              
1186             1;
1187              
1188             __END__