Related
In attempting to create a spreadsheet using cell properties previously defined, I'm having issues where the cell formatting is only sporadically being written in the cells. The values are there, but the font color, etc. is not always there.
Here's my code:
$result_file = $toxls . ".excel_props.xls";
$property_file = "properties.txt";
open (PROP, ">$property_file");
my $parser = Spreadsheet::ParseExcel->new();
my $workbook_parse = $parser->parse( $toxls );
my $worksheet_parse = $workbook_parse->Worksheet( $totab );
my ( $col_min, $col_max ) = $worksheet_parse->col_range();
my ( $row_min, $row_max ) = $worksheet_parse->row_range();
my $workbook = Spreadsheet::WriteExcel->new( $result_file );
my $worksheet = $workbook->addworksheet( $totab );
my %bkgd_color = ();
$worksheet->set_column('A:A', 12);
$worksheet->set_column('C:C', 15);
$worksheet->set_column('D:D', 30);
$worksheet->set_column('E:E', 30);
$worksheet->set_column('F:F', 35);
$worksheet->set_column('G:G', 40);
$worksheet->set_column('I:I', 40);
for my $col ( $col_min .. $col_max ) {
for my $row ( $row_min .. $row_max ) {
# Return the cell object at $row and $col
my $cell = $worksheet_parse->get_cell( $row, $col );
next unless $cell;
my $value = $cell->value();
my $format = $cell->get_format();
my $pattern = $format->{Fill}->[0];
my $color1 = $format->{Fill}->[1];
my $color2 = $format->{Fill}->[2];
my $font = $format->{Font};
my $fontcolor = $font->{Color};
## Change value if font color = black
if ($fontcolor eq '32767') {
$fontcolor = "8";
}
my $wrap = $format->{Wrap};
my $bold = $font->{Bold};
print PROP "\nRow, Col = ($row, $col)\n";
print PROP "Pattern = $pattern\n";
print PROP "Value = $value\n";
print PROP "Fill = $pattern $color1 $color2\n";
print PROP "Wrap = $wrap\n";
print PROP "Font = $fontcolor\n";
print PROP "Bold = $bold\n";
if (index($value,"B\=baseline") > -1 || index($value,"B\=Baseline") > -1) {
$worksheet->set_row($row, 150);
}
if ($pattern == 1 ){
if ( ! exists $bkgd_color{$color1} ){
$bkgd_color{$color1} = $workbook->add_format(
pattern => $pattern,
bg_color => $color1,
align => 'left',
valign => 'top',
text_wrap => $wrap,
border => 1,
color => $fontcolor,
bold => $bold
);
print PROP "Print segment = not exist bkgd_color\n";
}
$worksheet->write( $row, $col, $value, $bkgd_color{$color1});
} else {
$format = $workbook->add_format();
$format->set_pattern($pattern);
$format->set_align('left');
$format->set_valign('top');
$format->set_bg_color($color2);
$format->set_fg_color($color1);
$format->set_color($fontcolor);
$format->set_text_wrap($wrap);
$format->set_border();
$format->set_bold($bold);
print PROP "Fontcolor = $fontcolor\n";
$worksheet->write( $row, $col, $value, $format);
}
}
}
The properties.txt file shows what I expect when I parse the $toxls spreadsheet, which I'm using to test with. Yet, it doesn't always produce the formatting (font color, Align, and AlignH) that is being saved from the parse, when I write back out to the $result_file. Any ideas?
The properties.txt file looks good:
Row, Col = (2, 3)
Pattern = 1
Value = Password Requirements
Fill = 1 22 31
Wrap = 1
Font = 10 <-- red text
Bold = 1
Row, Col = (3, 3)
Pattern = 1
Value = Logging
Fill = 1 22 31
Wrap = 1
Font = 12 <--- blue text
Bold = 0
Row, Col = (4, 3)
Pattern = 0
Value = Logging
Fill = 0 64 65
Wrap = 1
Font = 12
Bold = 0
Fontcolor = 12
Row, Col = (5, 3)
Pattern = 1
Value = AntiVirus
Fill = 1 22 31
Wrap = 1
Font = 8 <-- black text
Bold = 0
My goal is simply to read in an existing spreadsheet, then create a new one with the exception of altering the font color or fill color on some cells. I tried this snippet, and it even missed formatting on many of the cells:
for my $col ( $col_min .. $col_max ) {
for my $row ( $row_min .. $row_max ) {
# Return the cell object at $row and $col
my $cell = $worksheet_parse->get_cell( $row, $col );
next unless $cell;
my $value = $cell->value();
my $format = $cell->get_format();
$worksheet->write( $row, $col, $value, $format);
}
}
I'm not quite sure why you are saving the format to $bkgd_color{$color1} other than to save some processing time but I suspect that is where your problem is. Try changing that section of your code to:
if ( $pattern == 1 ) {
$format = $workbook->add_format(
pattern => $pattern,
bg_color => $color1,
align => 'left',
valign => 'top',
text_wrap => $wrap,
border => 1,
color => $fontcolor,
bold => $bold
);
$worksheet->write( $row, $col, $value, $format);
}
See this new code removing the bgcolor logic. Yet, the resulting spreadsheet is only partially formatted correctly:
my $parser = Spreadsheet::ParseExcel->new();
my $workbook_parse = $parser->parse( $toxls );
my $worksheet_parse = $workbook_parse->Worksheet( $totab );
my ( $col_min, $col_max ) = $worksheet_parse->col_range();
my ( $row_min, $row_max ) = $worksheet_parse->row_range();
my $workbook = Spreadsheet::WriteExcel->new( $result_file );
my $worksheet = $workbook->addworksheet( $totab );
$worksheet->set_column('A:A', 12);
$worksheet->set_column('C:C', 15);
$worksheet->set_column('D:D', 30);
$worksheet->set_column('E:E', 30);
$worksheet->set_column('F:F', 35);
$worksheet->set_column('G:G', 40);
$worksheet->set_column('I:I', 40);
for my $row ( $row_min .. $row_max ) {
for my $col ( $col_min .. $col_max ) {
# Return the cell object at $row and $col
my $cell = $worksheet_parse->get_cell($row,$col);
next unless $cell;
my $value = $cell->value();
my $format = $cell->get_format();
my $pattern = $format->{Fill}->[0];
my $color1 = $format->{Fill}->[1];
my $color2 = $format->{Fill}->[2];
my $wrap = $format->{Wrap};
my $font = $format->{Font};
my $fontcolor = $font->{Color};
my $bold = $font->{Bold};
## Change value if font color = black
if ($fontcolor eq '32767') {
$fontcolor = "8";
}
## Freeze after the header row
if (index($value,"B\=baseline") > -1 || index($value,"B\=Baseline") > -1) {
$worksheet->set_row($row, 150);
$freezerow = $row + 1;
$worksheet->freeze_panes($freezerow, 0);
}
my $updformat = $workbook->add_format(
pattern => $pattern,
fg_color => $color1,
bg_color => $color2,
align => 'left',
valign => 'top',
text_wrap => $wrap,
border => 1,
color => $fontcolor,
bold => $bold
);
$worksheet->write( $row, $col, $value, $updformat);
}
}
We have a batch process in our system which will convert an Excel .xlsx file to CSV format using Perl. When it converts the CSV file it produces some symbols like Â, so I am not getting the expected result. Can some please help me how to use the same value as in the Excel file while converting to CSV?
Value in Excel file:
Unverifiable License Documentation NB Only
Value converted in CSV through Perl:
Unverifiable License Documentation – NB Only
I want to retain the same value that is in Excel while converting to CSV
Note: I used Encoding(UTF-8) while opening the file but even then it didn't work.
My Perl code
use Spreadsheet::XLSX;
use File::Basename;
use set_env_cfg;
use Date::Simple (':all');
use Math::Round;
$sts = open( INP, "< ${if}" );
#$sts = open (INP, '<:encoding(UTF-8)', ${if} );
#$sts = open (INP, '<:encoding(ISO-8859-1)', ${if} );
if ( $sts == 0 ) {
print LOG tmstmp() . ": Error opening input file\n";
close LOG;
print LOG "$ldlm\n";
`cp $lf $od`;
die;
}
print LOG "$ldlm\n";
print LOG tmstmp() . ": Conversion started for $if\n";
$oBook = Spreadsheet::XLSX->new($if);
foreach $WkS ( #{ $oBook->{Worksheet} } ) {
print LOG tmstmp() . ": Converting worksheet ----- " . $WkS->{Name}, "\n";
$cfgrec = ''; # initialize the configure record
$sts = open( OUT, ">$od/$WkS->{Name}.txt" );
if ( $sts == 0 ) {
print LOG tmstmp() . ": Error opening output file\n";
close LOG;
close INP;
print LOG "$ldlm\n";
`cp $lf $od`;
die;
}
$WkS->{MaxRow} ||= $WkS->{MinRow};
foreach $iR ( $WkS->{MinRow} .. $WkS->{MaxRow} ) {
$WkS->{MaxCol} ||= $WkS->{MinCol};
print OUT $cfgkey if ( ( $cfgko == 0 ) && ( $iR >= $hdrcnt ) );
foreach $iC ( $WkS->{MinCol} .. $WkS->{MaxCol} ) {
$cell = $WkS->{Cells}[$iR][$iC];
if ($cell) {
if ( ( $cell->{Type} ) eq "Date" ) {
if ( int( $cell->{Val} ) == ( $cell->{Val} ) ) {
$tmpval = date("1900-01-01") + ( $cell->{Val} ) - 2;
}
else {
$css = round( ( ( $cell->{Val} ) - int( $cell->{Val} ) ) * 86400 );
$cmi = int( $css / 60 );
$chr = int( $css / 3600 );
$css = $css - $cmi * 60;
$cmi = $cmi - $chr * 60;
$tmpval = date("1900-01-01") + int( $cell->{Val} ) - 2;
$tmpval .= " $chr:$cmi:$css";
}
}
else {
$tmpval = Spreadsheet::XLSX::Utility2007::unescape_HTML( $cell->{Val} );
}
print OUT $tmpval; ###Added double quotes in txt file to handle the comma delimiter value
}
if ( ( $iR == ${hdr_seq} - 1 ) ) {
if ( ( $cell->{Type} ) eq "Date" ) {
if ( int( $cell->{Val} ) == ( $cell->{Val} ) ) {
$tmpval = date("1900-01-01") + ( $cell->{Val} ) - 2;
}
else {
$css = round( ( ( $cell->{Val} ) - int( $cell->{Val} ) ) * 86400 );
$cmi = int( $css / 60 );
$chr = int( $css / 3600 );
$css = $css - $cmi * 60;
$cmi = $cmi - $chr * 60;
$tmpval = date("1900-01-01") + int( $cell->{Val} ) - 2;
$tmpval .= " $chr:$cmi:$css";
}
}
else {
$tmpval = Spreadsheet::XLSX::Utility2007::unescape_HTML( $cell->{Val} );
}
$cfgrec .= $tmpval;
}
if ( ( $iC == 0 ) && ( $iR == ${hdr_seq} ) ) {
$cfgrec = uc($cfgrec);
$cfgko = cnt_ocr( $cfgrec, $keyhdr );
$cfgkey = "*|" x ( $klm - $cfgko );
}
print OUT "|" if ( $iC < $WkS->{MaxCol} );
print OUT $cfgkey if ( ( $cfgko == $iC + 1 ) && ( $iR >= $hdrcnt ) );
}
print OUT "\n";
}
print LOG tmstmp() . ": Worsheet conversion completed successfully ----- " . $WkS->{Name}, "\n";
close OUT;
push #csv_file_lst, "$WkS->{Name}.txt";
}
print LOG tmstmp() . ": Conversion completed successfully for $if\n";
My guess is that your Excel file contains data encoded using the Windows-1252 code page that has been reencoded into UTF-8 without first being decoded
This string from your Excel file
Unverifiable License Documentation – NB Only
contains an EN DASH, which is represented as "\x96" in Windows-1252. If this is again encoded into UTF-8 the result is the two bytes "\xC2\x96". Interpreting this using Windows-1252 results in the two characters LATIN CAPITAL LETTER A WITH CIRCUMFLEX followed by EN DASH, which is what you're seeing
As far as I can tell, the only change necessary is to open your file with Windows-1252 decoding, like this
open my $fh, '<:encoding(Windows-1252)', $excel_file or die $!
Update
Your revised question shows your Perl code, but has removed the essential information from the Excel data that you show. This string
Unverifiable License Documentation NB Only
now has just two spaces between Documentation and NB and omits the "0x96" n-dash
Note — I've since restored the original data and tidied your code.
Your various attempts at opening the input file are here
$sts=open (INP, "< ${if}" );
#$sts=open (INP, '<:encoding(UTF-8)', ${if} );
#$sts=open (INP, '<:encoding(ISO-8859-1)', ${if} );
and you came very close with ISO-8859-1, but Microsft, in their wisdom, have reused the gaps in ISO-8859-1 encoding between 0x7F and 0x9F to represent printable characters in Windows-1252. The n-dash character at 0x96 is inside this range, so decoding your input as ISO-8859-1 won't render it correctly
As far as I can see, you just need to write
$sts = open (INP, '<:encoding(Windows-1252)', ${if} );
and your input data will be read correctly
You should also specify the encoding of your output file to avoid Wide character in print warnings and malformed data. I can't tell whether you want to duplicate the encoding of your Excel file, use UTF-8, or something else entirely, but you should change this
$sts = open( OUT, ">$od/$WkS->{Name}.txt" );
to either
$sts = open OUT, '>:encoding(Windows-1252)', "$od/$WkS->{Name}.txt";
or
$sts = open OUT, '>:encoding(UTF-8)', "$od/$WkS->{Name}.txt";
as appropriate
Note also that it is best practice to use the three-parameter form of open all the time, and it is best to use lexical file names instead of the global ones that you have. But this isn't a code review, so I've disregarded those points
I hope this underlines to you that it is vital to establish the encoding of your input data and decode it correctly. Guessing really isn't an option
Update
My apologies. I overlooked that the initial open is ignore by the Spreadsheet::XLSX module, which is passed a filename, rather than a file handle
This module is awkward in that it completely hides all character decoding, and relies on [Text::Iconv][Text::Iconv] to do the little conversion that it supports: something that is much better supported by Perl's own [Encode][Encode] module
The change I suggested to your open call is wrong, because it seems that a .xlsx file is a zipped file. However you never read from INP so it will make no difference. You should also close INP immediately after you have opened it as it is a wasted resource
Short of using a different module, the best thing I can suggest is that you hack the data returned by Spreadsheet::XLSX->new
This block will correct the erroneous re-encoding. I have added it right before your foreach $iR ( ... )` loop
You will need to add
use Encode qw/ decode :fallbacks /;
to the top of your code
Please let me know how you get on. Now I really must go!
{
my $columns = $WkS->{Cells};
for my $row ( #$columns ) {
next unless $row;
for my $cell ( #$row) {
next unless $cell and $cell->type eq 'Text';
for ( $cell->{_Value} ) {
$_ = decode('UTF-8', $_, FB_CROAK);
$_ = decode('Windows-1252', $_, FB_CROAK);
}
}
}
}
We need to make a program to analyse a DNA sequence with Perl. Mine is the last task: to analyse the result file from the others.
This is a column of numbers which are sorted from smallest to biggest. The result file
I have three parameters get from the STDIN. They are $from, $to, and $intervals. For example
1000 5000 200
In this case, the range 1000 .. 5000 is divided into 20 bins. Each bin's size is 200. The program should scan the data file and find whether the number is in the current bin. If it is in this bin, then calculate it and go to the next line until the number is out of this bin; then go to the next bin. If it is not in the current bin, then go to the next bin and do nothing about it.
The final result should be look like this
Here is my script about this part. My questions are in the script.
while ( defined( my $m_z_value = <$ff> ) ) {
$m_z_value =~ s/^\s+//; # /
GOD:
chomp $m_z_value;
if ( $tmp_to <= $to and $m_z_value <= $to ) { # limit the bin in the range
if ( $m_z_value >> $tmp_to ) { # Here if I don't use double ">", the program will just ignore it. Even I use double ">",sometime it still don't work, I don't know why?
++$bin_number;
print "$bin_number\t\t $tmp_from\t $tmp_to\t 0\t\t -\n";
$tmp_from = $tmp_from + $intervals;
$tmp_to = $tmp_to + $intervals;
goto GOD; # if the value is in the main range but out of the bin, move to the next bin and test it again
}
else {
if ( $m_z_value < $from ) {
goto MIRACLE; # if the value is before the range, go to next line
}
else {
if ( $m_z_value == $from ) { # similar problem, if I don't use double "=", in this part, the program will define the value of $m_z_value the same as $from
$mass = $mass + $m_z_value;
$whole_mass = $whole_mass + $m_z_value;
++$bin_pepnumber;
++$whole_pepnumber;
print "$bin_number\t\t $tmp_from\t $tmp_to\t $bin_pepnumber\t\t $mass/$bin_pepnumber\n";
}
else {
if ( $m_z_value >= $tmp_from and $m_z_value <= $tmp_to ) {
$mass = $mass + $m_z_value;
$whole_mass = $whole_mass + $m_z_value;
++$bin_pepnumber;
++$whole_pepnumber;
}
else {
if ( $m_z_value > $tmp_to ) {
print "$bin_number\t\t $tmp_from\t $tmp_to\t $bin_pepnumber\t\t $mass/$bin_pepnumber\n";
++$bin_number;
$mass = $m_z_value;
$whole_mass = $whole_mass + $m_z_value;
$bin_pepnumber = 0;
++$whole_pepnumber;
$tmp_from = $tmp_from + $intervals;
$tmp_to = $tmp_to + $intervals;
goto GOD; #if the m/z value is bigger than the range, go to next bin and test it again
}
}
}
}
}
MIRACLE:
}
}
First thing, the bin number is easy to calculate directly:
$bin_number = int (($m_z_value - $from) / $intervals);
Next thing, perl has arrays for representing things like bins:
++$bin_pep_number[$bin_number];
$mass[$bin_number] += $m_z_value;
Putting it all together:
my #bin_pep_number;
my #mass;
my $bin_number;
while(defined(my $m_z_value = <$ff>)) {
$m_z_value =~ s/^\s+//;
chomp $m_z_value;
$bin_number = int (($m_z_value - $from) / $intervals);
++$bin_pep_number[$bin_number];
$mass[$bin_number] += $m_z_value;
}
$bin_number = 0;
for (my $tmp_from=$from; $tmp_from<$to; $tmp_from+=$intervals) {
my $tmp_to = $tmp_from + $intervals;
print "$bin_number\t\t";
print "$tmp_from\t";
print "$tmp_to\t";
print "$bin_pepnumber[$bin_number]\t\t";
print "$mass[$bin_number]/$bin_pepnumber[$bin_number]" if $bin_pep_number[$bin_number];
print "\n";
++$bin_number;
}
I need a FileMaker "calculation" script to convert a DMS latlong (eg: 37°55'43.6"S, 145°11'26.1"E) to a decimal format (eg: -37.928778,145.190583).
Here's a fun way to do it: convert it to a FileMaker calculation and call Evaluate() on it.
Evaluate(
"Round( (" &
Substitute (
dms ;
[" ";""] ;
["°";" + "] ;
["'";"/60 + "] ;
["\"";"/3600"] ;
["S";") *-1"] ;
["W";") *-1"] ;
["N";")"] ;
["E";")"] ;
[","; " ; 6 ) & \",\" & Round( ("]
) &
" ; 6 )"
)
The above will turn the input into a calc like:
Round( (37 + 55/60 + 43.6/3600) *-1 ; 6 ) & "," & Round( (145 + 11/60 + 26.1/3600) ; 6 )
then passes that to Evaluate, which gives you -37.928778,145.190583
Here is one that uses the split() custom function by David Snyder:
If ( IsEmpty(DMSLatlong);"";
"-" &
Truncate(
(
Trim(split(
Trim(split( DMSLatlong; 1; "," ))
; 1; "°" ))
) +
(
(
Trim(split(
Trim(split(
Trim(split( DMSLatlong; 1; "," ))
; 1; "'" ))
; 2; "°" ))
) / 60
) +
(
(
Trim(split(
Trim(split(
Trim(split( DMSLatlong; 1; "," ))
; 2; "'" ))
; 1; "\"" ))
) / 3600
)
;7)
& "," &
Truncate(
(
Trim(split(
Trim(split( DMSLatlong; 2; "," ))
; 1; "°" ))
) +
(
(
Trim(split(
Trim(split(
Trim(split( DMSLatlong; 2; "," ))
; 1; "'" ))
; 2; "°" ))
) / 60
) +
(
(
Trim(split(
Trim(split(
Trim(split( DMSLatlong; 2; "," ))
; 2; "'" ))
; 1; "\"" ))
) / 3600
)
;7)
)
Note: This script isn't bullet proof, and if DMS values are S or W, you may need to tweak it to put a - sign in front (as I have done above). Refer to: Wikipedia: Conversion from Decimal Degree to DMS.
It could be as simple as =
Let ( [
v = Substitute ( DMS ; [ "°" ; ¶ ] ; [ "'" ; ¶ ] ; [ "\"" ; ¶ ] ) ;
t = Time ( GetValue ( v ; 1 ) ; GetValue ( v ; 2 ) ; GetValue ( v ; 3 ) ) ;
h = GetValue ( v ; 4 )
] ;
If ( h = "S" or h = "W" ; -t ; t ) / 3600
)
For those not familiar with the game. You're given 8 numbers and you have to reach the target by using +, -, / and *.
So if the target is 254 and your game numbers are 2, 50, 5, 2, 1, you would answer the question correctly by saying 5 * 50 = 250. Then 2+2 is four. Add that on aswell to get 254.
Some videos of the game are here:
Video 1
video 2
Basically I brute force the game using by generating all perms of all sizes for the numbers and all perms of the symbols and use a basic inflix calculator to calculate the solution.
However it contains a flaw because all the solutions are solved as following: ((((1+1)*2)*3)*4). It doesn't permutate the brackets and it's causing my a headache.
Therefore I cannot solve every equation. For example, given
A target of 16 and the numbers 1,1,1,1,1,1,1,1 it fails when it should do (1+1+1+1)*(1+1+1+1)=16.
I'd love it in someone could help finish this...in any language.
This is what I've written so far:
#!/usr/bin/env perl
use strict;
use warnings;
use Algorithm::Permute;
# GAME PARAMETERS TO FILL IN
my $target = 751;
my #numbers = ( '2', '4', '7', '9', '1', '6', '50', '25' );
my $num_numbers = scalar(#numbers);
my #symbols = ();
foreach my $n (#numbers) {
push(#symbols, ('+', '-', '/', '*'));
}
my $num_symbols = scalar(#symbols);
print "Symbol table: " . join(", ", #symbols);
my $lst = [];
my $symb_lst = [];
my $perms = '';
my #perm = ();
my $symb_perms = '';
my #symb_perm;
my $print_mark = 0;
my $progress = 0;
my $total_perms = 0;
my #closest_numbers;
my #closest_symb;
my $distance = 999999;
sub calculate {
my #oprms = #{ $_[0] };
my #ooperators = #{ $_[1] };
my #prms = #oprms;
my #operators = #ooperators;
#print "PERMS: " . join(", ", #prms) . ", OPERATORS: " . join(", ", #operators);
my $total = pop(#prms);
foreach my $operator (#operators) {
my $x = pop(#prms);
if ($operator eq '+') {
$total += $x;
}
if ($operator eq '-') {
$total -= $x;
}
if ($operator eq '*') {
$total *= $x;
}
if ($operator eq '/') {
$total /= $x;
}
}
#print "Total: $total\n";
if ($total == $target) {
#print "ABLE TO ACCURATELY SOLVE WITH THIS ALGORITHM:\n";
#print "PERMS: " . join(", ", #oprms) . ", OPERATORS: " . join(", ", #ooperators) . ", TOTAL=$total\n";
sum_print(\#oprms, \#ooperators, $total, 0);
exit(0);
}
my $own_distance = ($target - $total);
if ($own_distance < 0) {
$own_distance *= -1;
}
if ($own_distance < $distance) {
#print "found a new solution - only $own_distance from target $target\n";
#print "PERMS: " . join(", ", #oprms) . ", OPERATORS: " . join(", ", #ooperators) . ", TOTAL=$total\n";
sum_print(\#oprms, \#ooperators, $total, $own_distance);
#closest_numbers = #oprms;
#closest_symb = #ooperators;
$distance = $own_distance;
}
$progress++;
if (($progress % $print_mark) == 0) {
print "Tested $progress permutations. " . (($progress / $total_perms) * 100) . "%\n";
}
}
sub factorial {
my $f = shift;
$f == 0 ? 1 : $f*factorial($f-1);
}
sub sum_print {
my #prms = #{ $_[0] };
my #operators = #{ $_[1] };
my $total = $_[2];
my $distance = $_[3];
my $tmp = '';
my $op_len = scalar(#operators);
print "BEST SOLUTION SO FAR: ";
for (my $x = 0; $x < $op_len; $x++) {
print "(";
}
$tmp = pop(#prms);
print "$tmp";
foreach my $operator (#operators) {
$tmp = pop(#prms);
print " $operator $tmp)";
}
if ($distance == 0) {
print " = $total\n";
}
else {
print " = $total (distance from target $target is $distance)\n";
}
}
# look for straight match
foreach my $number (#numbers) {
if ($number == $target) {
print "matched!\n";
}
}
for (my $x = 1; $x < (($num_numbers*2)-1); $x++) {
$total_perms += factorial($x);
}
print "Total number of permutations: $total_perms\n";
$print_mark = $total_perms / 100;
if ($print_mark == 0) {
$print_mark = $total_perms;
}
for (my $num_size=2; $num_size <= $num_numbers; $num_size++) {
$lst = \#numbers;
$perms = new Algorithm::Permute($lst, $num_size);
print "Perms of size: $num_size.\n";
# print matching symb permutations
$symb_lst = \#symbols;
$symb_perms = new Algorithm::Permute($symb_lst, $num_size-1);
while (#perm = $perms->next) {
while (#symb_perm = $symb_perms->next) {
calculate(\#perm, \#symb_perm);
}
$symb_perms = new Algorithm::Permute($symb_lst, $num_size-1);
}
}
print "exhausted solutions";
print "CLOSEST I CAN GET: $distance\n";
sum_print(\#closest_numbers, \#closest_symb, $target-$distance, $distance);
exit(0);
Here is the example output:
[15:53: /mnt/mydocuments/git_working_dir/countdown_solver$] perl countdown_solver.pl
Symbol table: +, -, /, *, +, -, /, *, +, -, /, *, +, -, /, *, +, -, /, *, +, -, /, *, +, -, /, *, +, -, /, *Total number of permutations: 93928268313
Perms of size: 2.
BEST SOLUTION SO FAR: (2 + 4) = 6 (distance from target 751 is 745)
BEST SOLUTION SO FAR: (2 * 4) = 8 (distance from target 751 is 743)
BEST SOLUTION SO FAR: (4 + 7) = 11 (distance from target 751 is 740)
BEST SOLUTION SO FAR: (4 * 7) = 28 (distance from target 751 is 723)
BEST SOLUTION SO FAR: (4 * 9) = 36 (distance from target 751 is 715)
BEST SOLUTION SO FAR: (7 * 9) = 63 (distance from target 751 is 688)
BEST SOLUTION SO FAR: (4 * 50) = 200 (distance from target 751 is 551)
BEST SOLUTION SO FAR: (7 * 50) = 350 (distance from target 751 is 401)
BEST SOLUTION SO FAR: (9 * 50) = 450 (distance from target 751 is 301)
Perms of size: 3.
BEST SOLUTION SO FAR: ((4 + 7) * 50) = 550 (distance from target 751 is 201)
BEST SOLUTION SO FAR: ((2 * 7) * 50) = 700 (distance from target 751 is 51)
BEST SOLUTION SO FAR: ((7 + 9) * 50) = 800 (distance from target 751 is 49)
BEST SOLUTION SO FAR: ((9 + 6) * 50) = 750 (distance from target 751 is 1)
Perms of size: 4.
BEST SOLUTION SO FAR: (((9 + 6) * 50) + 1) = 751
Here is Java applet (source) and Javascript version.
The suggestion to use reverse polish notation is excellent.
If you have N=5 numbers, the template is
{num} {num} {ops} {num} {ops} {num} {ops} {num} {ops}
There can be zero to N ops in any spot, although the total number will be N-1. You just have to try different placements of numbers and ops.
The (((1+1)+1)+1)*(((1+1)+1)+1)=16 solution will be found when you try
1 1 + 1 + 1 + 1 1 + 1 + 1 + *
Update: Maybe not so good, since finding the above could take 433,701,273,600 tries. The number was obtained using the following:
use strict;
use warnings;
{
my %cache = ( 0 => 1 );
sub fact { my ($n) = #_; $cache{$n} ||= fact($n-1) * $n }
}
{
my %cache;
sub C {
my ($n,$r) = #_;
return $cache{"$n,$r"} ||= do {
my $i = $n;
my $j = $n-$r;
my $c = 1;
$c *= $i--/$j-- while $j;
$c
};
}
}
my #nums = (1,1,1,1,1,1,1,1);
my $Nn = 0+#nums; # Number of numbers.
my $No = $Nn-1; # Number of operators.
my $max_tries = do {
my $num_orderings = fact($Nn);
{
my %counts;
++$counts{$_} for #nums;
$num_orderings /= fact($_) for values(%counts);
}
my $op_orderings = 4 ** $No;
my $op_placements = 1;
$op_placements *= C($No, $_) for 1..$No-1;
$num_orderings * $op_orderings * $op_placements
};
printf "At most %.f tries needed\n", $max_tries;