I have a following lines in a file..
- VSSC!.extra196 + NET VSSC!
+ DIRECTION INOUT
+ USE GROUND
+ LAYER BA ( 0 0 ) ( 1500 80870 )
+ PLACED ( 1055560 1571000 ) N ;
- VSSC!.extra197 + NET VSSC!
+ DIRECTION INOUT
+ USE GROUND
+ LAYER BA ( 0 0 ) ( 1500 80870 )
+ PLACED ( 1055560 1571000 ) N ;
- VSSC!.extra198 + NET VSSC!
+ DIRECTION INOUT
+ USE GROUND
+ LAYER BA ( 0 0 ) ( 1500 80870 )
+ PLACED ( 1043560 1571000 ) N ;
I want to append every 3rd line with first line..
eg: `- VSSC!.extra198 + NET VSSC! + USE GROUND + SPECIAL
by using match operator I am able to catch the first line and 3rd line. and next task is, how to append and add a word called +SPECIAL to it?
use warnings;
my #array;
open(my $fh, "<", "sample.txt") or die "Failed to
open file: $!\n";
while(<$fh>) {
my $i; chomp; push #array, $_;
}
close $fh;
for(i=0;i<3;i++)
{
print "$array[i] $array[i+2] +SPECIAL \n";
}
For tasks like this, it is useful to form groups of lines in a first step. Then, in a second loop, you have each group in your access, and you can rearrange or modify easily:
use strict;
use warnings;
# First, form the groups
# Each group starts with a line matching a certain pattern, e.g. /^\-/
my #groups = ();
my $current;
foreach my $line (<DATA>) {
chomp $line;
next unless $line;
if ($line =~ /^\-/) {
push #groups, $current if $current;
$current = [];
}
push #$current, $line;
}
push #groups,$current if (scalar #$current > 0); # last group
# Now you have the groups, you can manipulate the output
# and print it comfortably in a modified form
foreach (#groups) {
my #current = #{ $_ };
foreach my $i (0..$#current) {
if ($i==0) {
print "$current[$i] $current[$i+2] +SPECIAL\n";
}
else {
print "$current[$i]\n";
}
}
}
__DATA__
- VSSC!.extra196 + NET VSSC!
+ DIRECTION INOUT
+ USE GROUND
+ LAYER BA ( 0 0 ) ( 1500 80870 )
+ PLACED ( 1055560 1571000 ) N ;
- VSSC!.extra197 + NET VSSC!
+ DIRECTION INOUT
+ USE GROUND
+ LAYER BA ( 0 0 ) ( 1500 80870 )
+ PLACED ( 1055560 1571000 ) N ;
- VSSC!.extra198 + NET VSSC!
+ DIRECTION INOUT
+ USE GROUND
+ LAYER BA ( 0 0 ) ( 1500 80870 )
+ PLACED ( 1043560 1571000 ) N ;
To make it standalone, I have put your sample data as __DATA__ at the end of the script. You can, of course, read in the lines from a file as well, this would require some slight changes of the first part of the script.
This is easier than it sounds - your data has a delimiter ;.
So you can set $/ and use that.
#!/usr/bin/env perl
use strict;
use warnings;
local $/ = ";\n";
while ( <DATA> ) {
chomp;
my #chunk = split /\n/;
print join ( " ", #chunk[0,2], " + SPECIAL" ),"\n";
}
__DATA__
- VSSC!.extra196 + NET VSSC!
+ DIRECTION INOUT
+ USE GROUND
+ LAYER BA ( 0 0 ) ( 1500 80870 )
+ PLACED ( 1055560 1571000 ) N ;
- VSSC!.extra197 + NET VSSC!
+ DIRECTION INOUT
+ USE GROUND
+ LAYER BA ( 0 0 ) ( 1500 80870 )
+ PLACED ( 1055560 1571000 ) N ;
- VSSC!.extra198 + NET VSSC!
+ DIRECTION INOUT
+ USE GROUND
+ LAYER BA ( 0 0 ) ( 1500 80870 )
+ PLACED ( 1043560 1571000 ) N ;
This prints:
- VSSC!.extra196 + NET VSSC! + USE GROUND + SPECIAL
- VSSC!.extra197 + NET VSSC! + USE GROUND + SPECIAL
- VSSC!.extra198 + NET VSSC! + USE GROUND + SPECIAL
I've already written code that can perform the following conversions to an input string
3(7x-1)+10x-4+3x=90x+1
(3*(7x-1)+10x-4+3x)-(90x+1)
37x1-*10x+4-3x+90x1+-
But now, I'm a little stuck with this last one. I know how to write the code to solve RPN without an X involved. However, I'm not sure how to parse this with the x'es involved.
EIDT: I have fixed the incorrect RPN error, and it now reads
3 7 x * 1 - * 10 x * + 4 - 3 x * + 90 x * 1 + -
parsing this RPN string is what I'm worried about.
The whole point of RPN is that it doesn't require any parsing. You can work with the output of the tokenizer directly.
sub get_next_token {
/\G \s+ /xgc;
/\G \z /xgc && return [ 'EOF' ];
/\G ( [0-9]+ ) /xgc && return [ NUM => $1 ];
/\G ( [a-z] ) /xgc && return [ VAR => $1 ];
/\G ( [*+\-] ) /xgc && return [ $1 ];
die("Syntax error\n");
}
my %ops = (
EOF => sub { my $token = shift; ...; return 0; },
NUM => sub { my $token = shift; ...; return 1; },
VAR => sub { my $token = shift; ...; return 1; },
'*' => sub { my $token = shift; ...; return 1; },
'+' => sub { my $token = shift; ...; return 1; },
'-' => sub { my $token = shift; ...; return 1; },
);
for ($rpn) {
while (1) {
my $token = get_next_token();
my $op = $opts{$token}
or die("Internal error");
last if !$op->($token);
}
}
Note that you don't have valid RPN.
(3(7x-1)+10x-4+3x)-(90x+1)
should result in
3 7 x * 1 - * 10 x * + 4 - 3 x * + 90 x * 1 + -
but you have
37 x 1 - * 10 x + 4 - 3 x + 90 x 1 + -
You're missing some multiplications, and you merged 3 and 7 into 37.
I'm not sure how to parse this with the x'es involved.
Seems like you've written a parser which handles grammars of the following form:
stmt : expr '=' expr
expr : sum
sum : prod '+' sum
| prod '-' sum
| prod
prod : term prod
| term
term : '(' expr ')'
| NUM
All you need to change is term.
term : '(' expr ')'
| NUM
| VAR
Math::RPN:
use Math::RPN;
$value=rpn(expr...);
#array=rpn(expr...);
expr... is one or more scalars or lists of scalars which contain
RPN expressions. An RPN expression is a series of numbers and/or
operators separated by commas. (commas are only required within
scalars).
I'm trying to describe a perl script for this purpose:
a = ~b & ~c; ==> a = (~b) & (~c);
a = ~b & (~c); ==> a = (~b) & (~c);
So I used lookahead assertions to insert parenthesis like this. Here is the test code.
#!/usr/local/bin/perl5 -w
use strict;
use warnings;
my $line;
my #lines;
#lines = (
"assign a = ~b & ~c;",
"assign a = (~b) & (~c);",
"assign a = ( ~b & ~c );",
"assign a = (b & ~c );"
);
foreach $line (#lines) {
print " $line\n";
$line =~ s/(?!\(\s*)~\w+(?!\s*\))/\($&\)/g;
print ">> $line\n\n";
}
It looks working with above examples. However, it's not working with this.
assign a = ~b & ~c;
>> assign a = (~b) & (~c); <== OK
assign a = (~b) & (~c);
>> assign a = (~b) & (~c); <== OK
assign a = ( ~b & ~c);
>> assign a = ( (~b) & ~c); <== X. I want ( (~b) & (~c));
assign a = ( ~b & ~c );
>> assign a = ( (~b) & ~c ); <== X. I want ( (~b) & (~c) );
Would you let me know how to fix the script? Thank you.
Your goal of using lookahead and lookbehind assertions doesn't really get you anything. Breaking up the code into two steps makes it easier in my opinion. One step to capture variables prefixed by ~, and the second part to see if they're surrounded by balanced parenthesis.
use strict;
use warnings;
while (<DATA>) {
chomp(my $src = <DATA>);
chomp(my $test = <DATA>);
$src =~ s{([(]?~\w+[)]?)}{
my $str = $1;
$str =~ /^\(.*\)$/ ? $str : "($str)";
}eg;
print "test $test\n";
print $src eq $test ? ' ok ' : ' FAIL! ';
print "$src\n";
}
__DATA__
Test:
a = ~b & ~c;
a = (~b) & (~c);
Test:
a = (~b) & (~c);
a = (~b) & (~c);
Test:
a = ( ~b & ~c);
a = ( (~b) & (~c));
Test:
a = ( ~b & ~c );
a = ( (~b) & (~c) );
results:
test a = (~b) & (~c);
ok a = (~b) & (~c);
test a = (~b) & (~c);
ok a = (~b) & (~c);
test a = ( (~b) & (~c));
ok a = ( (~b) & (~c));
test a = ( (~b) & (~c) );
ok a = ( (~b) & (~c) );
You can't easily do what you're asking using a single regular expression.
The problem is that there is no way to count the number of nested parentheses without writing a recursive regex pattern, so at the end of ~c simple regex cannot know whether how many parentheses are needed to close the expression.
This is possible with a more complex regex, but it would also be much easier to tokenize the string in a Perl loop.
Do you have to deal with stuff like a & ~b & c | (d | ~e & f)?
You can do this with one regex, here it is;
$line =~ s/(?|([^\(])(~\w+)(.)|(.)(~\w+)([^\)]))/$1\($2\)$3/g;
Your reqex wasn't doing what you thought.
$line =~ s/(?!\(\s*)~\w+(?!\s*\))/\($&\)/g;
the first part "(?!(\s*)~" will never match. Remember lookaheads and lookbehinds are zero width assertions. I like to think of them as matching the space in between the letters. (?!(\s*)~ means, that you want to match a "~" character, but in the space right before the "~"character, you want to lookahead and make sure you dont see a "(" and spaces. Well, if you are in the space right before a "~", you"ll never see a "(". And if your at a "(", the negative look ahead might fail to match (like you want) but you'd have never matched the "~" anyway.
You are trying to match if the character before is not a "(" AND the char after is not a ")". But what you want is to match if the character before is not a "(" OR the char after is not a ")". So you need a conditional branch, one to match if there is no "(" in front, and one to match if there is no ")" behind.
I used a condition branch, the (?| tells the engine to store the captured submatches like this;
(?|([^\\(])(~\w+)(.)|(.)(~\w+)([^\\)]))
$1 $2 $3 |$1 $2 $3
instead of this
([^\\(])(~\w+)(.)|(.)(~\w+)([^\\)]))
$1 $2 $3 |$4 $5 $6
I used (.) to make the ~\w part always $2, then just put a "(" ")" around the $2 in the output
my output
assign a = ~b & ~c;
assign a = (~b) & (~c);
assign a = (~b) & (~c);
assign a = (~b) & (~c);
assign a = ( ~b & ~c );
assign a = ( (~b) & (~c) );
assign a = (~b & ~c );
assign a = ((~b) & (~c) );
assign a = ( ~b & ~c );
assign a = ( (~b) & (~c) );
assign a = ( ~b & ~c);
assign a = ( (~b) & (~c));
This function reads (document.doc) files.. But it turns arabic characters into english characters
I want to make it read arabic characters , Or remove it at least.
function word($filename){
if(($fh = fopen($filename, 'r')) !== false ) {
$headers = fread($fh, 0xA00);
$n1 = ( ord($headers[0x21C]) - 1 );
$n2 = ( ( ord($headers[0x21D]) - 8 ) * 256 );
$n3 = ( ( ord($headers[0x21E]) * 256 ) * 256 );
$n4 = ( ( ( ord($headers[0x21F]) * 256 ) * 256 ) * 256 );
$textLength = ($n1 + $n2 + $n3 + $n4);
if($extracted_plaintext = #fread($fh, $textLength)){
}else{
return docx2text($filename); // Save this contents to file
}
$text=str_replace( chr(13) , "\n", $extracted_plaintext);
echo $text;
}
}
word('filename.doc');
E.X: filename.doc -> file contains statment "بسم الله الرحمن الرحيم"
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;