Is there a cleaner way to check for a condition to set a variable then to use a bunch of IF statements? - codesys

I am looking to possibly shorten my code. It seems super redundent but I am not sure how else I would be checking for a specific condition to set a variable besides a large IF statement?
IF MaxContaminationCode := -2 THEN
ContaminationClass := '000';
ELSIF MaxContaminationCode := -1 THEN
ContaminationClass := '00';
ELSIF MaxContaminationCode := 0 THEN
ContaminationClass := '0';
ELSIF MaxContaminationCode := 1 THEN
ContaminationClass := '1';
ELSIF MaxContaminationCode := 2 THEN
ContaminationClass := '2';
ELSIF MaxContaminationCode := 3 THEN
ContaminationClass := '3';
ELSIF MaxContaminationCode := 4 THEN
ContaminationClass := '4';
ELSIF MaxContaminationCode := 5 THEN
ContaminationClass := '5';
ELSIF MaxContaminationCode := 6 THEN
ContaminationClass := '6';
ELSIF MaxContaminationCode := 7 THEN
ContaminationClass := '7';
ELSIF MaxContaminationCode := 8 THEN
ContaminationClass := '8';
ELSIF MaxContaminationCode := 9 THEN
ContaminationClass := '9';
ELSIF MaxContaminationCode := 10 THEN
ContaminationClass := '10';
ELSIF MaxContaminationCode := 11 THEN
ContaminationClass := '11';
ELSIF MaxContaminationCode := 12 THEN
ContaminationClass := '12';
END_IF
With this code, I am checking to see if a calculated value (MaxContaminationCode), which is an INT, is a specific value. If it is the specific value set "ContaminationClass" (which is a string), to the respective value.

In general, if you have many different cases, then it is preferable to use the CASE statement ('switch' in other languages) as DrBwts said. Also, as Gereon said, in your example you could decrease the cases you check. So for your example it would look something like this:
CASE MaxContaminationCode OF
-2:
ContaminationClass := '000';
-1:
ContaminationClass := '00';
0..12: // if you ONLY want 0 to 12, otherwise use ELSE here
ContaminationClass := INT_TO_STRING(MaxContaminationCode);
END_CASE

I agree with suggestion above. But to make it even more compact (-2 lines).
ContaminationClass := INT_TO_STRING(MaxContaminationCode);
IF MaxContaminationCode = -2 THEN
ContaminationClass := '000';
ELSIF MaxContaminationCode = -1 THEN
ContaminationClass := '00';
END_IF

Related

Perl script to grep for always block and print the specified lines

I need to fetch the files , read line by line and search for always_ff block.
If always_ff is present, then i need to print the specific lines from inside the found always_ff block
use strict;
use warnings;
for my $file ('*.sv')
{
open my $fh, "<", $file or die $!;
while (<$fh>) {
print scalar <$fh> if /begin/;
}
}
The file has :
always_ff #(negedge clk )
begin
if (!clk)
begin
p1 <= 1'b0;
end
else
begin
p1 <= disable_ff;
end
end
always_ff #(negedge clk)
begin
if (!clk)
begin
p2<= enable;
end
else
begin
p2 <= disable_ff;
end
end
Expected result:
p1 <= disable_ff
p2<= enable
p2 <= disable_ff;
Actual result coming :
if (!clk)
p1 <= disable_ff;
You should probably use the range operator with patterns that match the start and the end of the section. Looking at your input data I would suggest:
start: match "always_ff" plus white space, i.e. /always_ff\s+/
end: empty line, i.e. /^\s*$/
in the block: print lines with assignment, i.e. /<=/
Quote from perlop:
In scalar context, .. returns a boolean value. The operator is bistable, like a flip-flop, ... It is false as long as its left operand is false. Once the left operand is true, the range operator stays true until the right operand is true, AFTER which the range operator becomes false again.
Something like this
#!/usr/bin/perl
use warnings;
use strict;
while (<DATA>) {
if (/always_ff\s+/../^\s*$/) {
print if /<=/;
}
}
exit 0;
__DATA__
always_ff #(negedge clk )
begin
if (!clk)
begin
p1 <= 1'b0;
end
else
begin
p1 <= disable_ff;
end
end
always_ff #(negedge clk)
begin
if (!clk)
begin
p2<= enable;
end
else
begin
p2 <= disable_ff;
end
end
Test output:
$ perl dummy.pl
p1 <= 1'b0;
p1 <= disable_ff;
p2<= enable;
p2 <= disable_ff;
For your use case of reading *.sv files replace <DATA> from my test code with <STDIN> and use the following shell command line:
$ cat *.sv | perl script.pl

How to subtract a column of values with another column of values?

I have two files with one column of values, like attachments below. I want to subtract the first value of file2 with all values in file1, these subtractions fill the first column in the output file, and then second value of file2 with all values in file1 ...
The output would look like this:
-4(2-6) -5 0 1
0(2-2) -1 4 5
-2(2-4) -3 2 3
-3(2-5) -4 1 2
-6(2-8) -7 -2 -1
Expressions in brackets in first column are only for explanation use and need to be discarded in output.
Also, the number of values in the column can vary.
Many thanks!
file1 file2
6 2
2 1
4 6
5 7
8
If I understand this correctly, then
awk 'NR == FNR { src[FNR] = $1; next } { for(i = 1; i <= length(src); ++i) { printf("%d\t", src[i] - $1); } print ""; }' file2 file1
produces the desired output. This works as follows:
NR == FNR { # while the first file (file2) is read:
src[FNR] = $1 # remember the numbers in an array
next # and we're done
}
{ # after that (when processing file1):
for(i = 1; i <= length(src); ++i) { # loop through the saved numbers
printf("%d\t", src[i] - $1) # subtract the current number from it,
# print result followed by tab
}
print "" # when done, print a newline
}
EDIT: Since the question was edited to use one file with two columns instead of two with one each: The code can be slightly tweaked for that scenario as follows:
awk 'NR == FNR && NF > 1 { src[FNR] = $2 } NR != FNR && $1 != "" { for(i = 1; i <= length(src); ++i) { printf("%d\t", src[i] - $1); } print ""; }' file file
This follows the same basic pattern: Two passes are done over the file, one in which the numbers of the second column are saved and another in which the output is calculated and printed. The main addition is handling for empty fields:
NR == FNR && NF > 1 { # If this is the first pass and there is
src[FNR] = $2 # a second field, remember it
}
NR != FNR && $1 != "" { # If this is the second pass and there is
for(i = 1; i <= length(src); ++i) { # a first field, process it as before.
printf("%d\t", src[i] - $1)
}
print ""
}
Alternatively, it could be done in one pass as follows:
awk '$1 != "" { a[NR] = $1 } NF > 1 { b[NR] = $2 } END { for(i = 1; i <= length(b); ++i) { for(j = 1; j <= length(a); ++j) { printf("%d\t", b[i] - a[j]) } print "" } }' file
That is:
$1 != "" { a[NR] = $1 } # If there is a first field, remember it
NF > 1 { b[NR] = $2 } # If there is a second field, remember it
END { # After reaching the end of the file,
for(i = 1; i <= length(b); ++i) { # process the saved data as before.
for(j = 1; j <= length(a); ++j) {
printf("%d\t", b[i] - a[j])
}
print ""
}
}

How do I use an incremented index in Perl's map function?

I'd like to use an incremented index in Perl, in the map function. The code I have is:
use strict;
my $ord = "46.15,18.59,47.45,21.14";
my $c = 1;
my #a = split(",",$ord);
my $str = join("\n", map "x($c++) := $_;", #a);
print $str;
This outputs:
x(1++) := 46.15;
x(1++) := 18.59;
x(1++) := 47.45;
x(1++) := 21.14;
Instead of the x(1++), I would like x(1), x(2), etc.
How can I reach it?
Instead of mapping the array, you can map your count, and not need a separate variable:
my $str = join("\n", map "x($_) := $a[$_-1];", 1..#a);
Or, to include a trailing newline:
my $str = join('', map "x($_) := $a[$_-1];\n", 1..#a);
Your problem has nothing to do with map. You placed Perl code inside a string literal and hoped it would get executed.
Replace
map "x($c++) := $_;",
with
map { ++$c; "x($c) := $_;" }
Also, you are missing a trailing newline. Fixed:
my $str = join "", map { ++$c; "x($c) := $_;\n" } #a;
print $str;
or
print map { ++$c; "x($c) := $_;\n" } #a;
It seems, that concatenating is the answer:
my $str = join("\n", map "x(".$c++.") := $_;", #a);

Evaluating Statements with '||' in Perl

Can someone please explain what's going on here, please?
I've simplified as much as I can.
( 1 || 2 == 1 ) is TRUE (as expected)
( 1 || 2 == 2 ) is TRUE (as expected)
I would also expect the following to both be true (but this may suggest a lack of understanding...)
( 1 == ( 1 || 2 ) ) is TRUE
( 2 == ( 1 || 2 ) ) is FALSE <--- !!! I don't understand this..
Now it starts getting a bit odd...
( 2 == 1 || 2 ) is TRUE
( 3 == 1 || 2 ) is TRUE <--- !!! I don't understand this..
After some more playing about, I find the following:
( 1 == ( 1 || 2 ) ) is FALSE
( 2 == ( 1 || 2 ) ) is TRUE
( 1 == ( 1 && 2 ) ) is TRUE
( 2 == ( 1 && 2 ) ) is FALSE
You might have guess that I'm trying to do something along the lines of:
sub foo {
# ... blah blah ...
return 0 if $status == ( 2 || 4 || 7 || 9);
# ... do other stuff ...
return 1;
}
my $result = foo();
if ($result) {
# then do something based on a result
} else {
# log failure or whatever
}
I know I can use this idiom, but the extra "$status"(es) seem superfluous:
return 0 if ( $status == 1 || $status == 4 || $status == 7 ); # and so on...
I also know I could use a regex with alternation or to check if the value is in an array of the allowable values.
But I'd like to understand why this is not as I expect.
$status == ( 2 || 4 || 7 || 9)
will not do what you expect. (And if it did do what you expect, what do you think $status == (2 && 4 && 7 && 9) should mean?) That statement is equivalent to
$status == 2
|| and && are binary operators that always return one of their scalar operands. It may help to think of them as equivalent to these binary functions:
sub OR {
my ($a,$b) = #_;
if ($a) {
return $a;
} else {
return $b;
}
}
sub AND {
my ($a,$b) = #_;
if ($a) {
return $b;
} else {
return $a;
}
}
(I'm glossing over the short-circuiting feature of || and &&, but that's not so important for this post).
Noting that == has higher precedence than || and &&, we can rewrite all your expressions in terms of AND and OR:
( 1 || 2 == 1 ) --> (OR(1,2==1)) ---> OR(1,0) --> 1 TRUE
( 1 || 2 == 2 ) --> (OR(1,2==2)) ---> OR(1,1) --> 1 TRUE
These two expressions are both true, but NOT for the reason you were expecting.
( 1 == ( 1 || 2 ) ) --> (1 == OR(1,2)) ---> (1==1) TRUE
( 2 == ( 1 || 2 ) ) --> (2 == OR(1,2)) ---> (2==1) FALSE
( 2 == 1 || 2 ) --> OR(2==1,2) ---> OR(0,2) --> 2 TRUE
( 3 == 1 || 2 ) --> OR(3==1,2) ---> OR(0,3) --> 3 TRUE
( 1 == ( 1 || 2 ) ) --> (1==OR(1,2)) ---> (1==1) TRUE, not FALSE
( 2 == ( 1 || 2 ) ) --> (2==OR(1,2)) ---> (2==1) FALSE, not TRUE
( 1 == ( 1 && 2 ) ) --> (1==AND(1,2)) ---> (1==1) TRUE
( 2 == ( 1 && 2 ) ) --> (2==AND(1,2)) ---> (2==1) FALSE
And your original idea of checking
$status == ( 2 || 4 || 7 || 9)
is equivalent to
$status == OR(OR(OR(2,4),7),9)
$status == OR(OR(2,7),9)
$status == OR(2,9)
$status == 2
( 2 == ( 1 || 2 ) ) is FALSE <--- !!! I don't understand this..
The || operator returns first “true” value it encounters or false. Therefore, 1||2 evaluates as 1 and the numeric comparison to 2 fails. As for your code, you might use Perl6::Junction:
if ($status == any(1, 4, 7)) {
...
}
The || operator simply doesn't work as you think (hope?) it does. You can see this by printing out the results of some expressions.
$ perl -E'say 1 || 2' # 1
$ perl -E'say 2 || 1' # 2
The operator is lazy. It only evaluates operands until it knows what the result is going to be.
Two ways to achieve what you want.
1/ Create a hash that contains the values you're interested in.
my %good_status = map { $_ => 1 } qw[2 4 7 9];
return if $good_status{$status};
2/ Use the any function from List::MoreUtils.
use List::Utils 'any';
return if any { $status == $_ } qw[2 4 7 9];
The || statement cannot be used in the way you'r trying to use it. It makes sense in English to say "if 1 is either 1 or 2", but in most if not all programming languages you must say "if 1 is 1 or 1 is 2" (that is, 1 == 1 || 1 == 2 or some macro thereof).
What's actually happening is that || and &&, when used on two numbers, are evaluating to the first nonzero value they find. So 1 || 6 -> 1 while 6 || 1 -> 6. Combined with == being evaluated first if no parentheses are involved, this results in:
( 1 || 2 == 1 ) -> (1) == 1 -> true
( 1 || 2 == 2 ) -> (1) == 2 -> false
( 1 == ( 1 || 2 ) ) -> 1 == (1) -> true
( 2 == ( 1 || 2 ) ) -> 2 == (1) -> false
( 2 == 1 || 2 ) -> false || 2 -> 2 -> true
( 3 == 1 || 2 ) -> false || 2 -> 2 -> true
( 1 == ( 1 || 2 ) ) -> 1 == (1) -> true
( 2 == ( 1 || 2 ) ) -> 2 == (1) -> false
( 1 == ( 1 && 2 ) ) -> 1 == (1) -> true
( 2 == ( 1 && 2 ) ) -> 2 == (1) -> false
You have been given explanations on the OR logic, so I will expend with that, just tell you that a precedence table can be found in perldoc perlop. You should be able to figure out the logic with that information.
What you are looking for, though, is probably the functionality of a switch statement:
use v5.10;
sub foo {
my $status = shift;
given ($status) {
when ([2,4,7,9]) { return 0 }
default { return 1 }
}
}
( 2 == ( 1 || 2 ) ) is FALSE <--- !!! I don't understand this..
( 1 || 2 ) is evaluated first at 1 then compared with 2 ==> of course false!!
( 3 == 1 || 2 ) is TRUE <--- !!! I don't understand this..
3 == 1 is evaluated first and result is 0/false then || 2 returns 2 <==> True.
return 0 if ( $status == 1 || $status == 4 || $status == 7 );
can be rewritten like:
return 0 if $status =~ /^[147]$/;
You see now that its the binary-ness of the operators that give them their behavior. Much stranger is the world of Quantum Mechanics, from which Quantum::Superpositions draws inspiration.
Try this for some fun (it does something a lot closer to your original expectations):
#!/usr/bin/env perl
use strict;
use warnings;
no warnings 'qw';
use Quantum::Superpositions;
my #cases = qw'
(any(1,2)==1)
(any(1,2)==2)
(1==any(1,2))
(2==any(1,2))
(2==any(1,2))
(3==any(1,2))
(1==any(1,2))
(2==any(1,2))
(1==all(1,2))
(2==all(1,2))
';
print "$_ -> ", eval, "\n" for #cases;
of course you can do even stranger things with these superposition states, like products of states etc. The whole thing is good for some light reading (if you're as geeky as I am).
Reading some of the other answers, this is also like the Perl6::Junctions module mentioned by zoul

Generating Synthetic DNA Sequence with Substitution Rate

Given these inputs:
my $init_seq = "AAAAAAAAAA" #length 10 bp
my $sub_rate = 0.003;
my $nof_tags = 1000;
my #dna = qw( A C G T );
I want to generate:
One thousand length-10 tags
Substitution rate for each position in a tag is 0.003
Yielding output like:
AAAAAAAAAA
AATAACAAAA
.....
AAGGAAAAGA # 1000th tags
Is there a compact way to do it in Perl?
I am stuck with the logic of this script as core:
#!/usr/bin/perl
my $init_seq = "AAAAAAAAAA" #length 10 bp
my $sub_rate = 0.003;
my $nof_tags = 1000;
my #dna = qw( A C G T );
$i = 0;
while ($i < length($init_seq)) {
$roll = int(rand 4) + 1; # $roll is now an integer between 1 and 4
if ($roll == 1) {$base = A;}
elsif ($roll == 2) {$base = T;}
elsif ($roll == 3) {$base = C;}
elsif ($roll == 4) {$base = G;};
print $base;
}
continue {
$i++;
}
As a small optimisation, replace:
$roll = int(rand 4) + 1; # $roll is now an integer between 1 and 4
if ($roll == 1) {$base = A;}
elsif ($roll == 2) {$base = T;}
elsif ($roll == 3) {$base = C;}
elsif ($roll == 4) {$base = G;};
with
$base = $dna[int(rand 4)];
EDIT: Assuming substitution rate is in the range 0.001 to 1.000:
As well as $roll, generate another (pseudo)random number in the range [1..1000], if it is less than or equal to (1000 * $sub_rate) then perform the substitution, otherwise do nothing (i.e. output 'A').
Be aware that you may introduce subtle bias unless the properties of your random number generator are known.
Not exactly what you are looking for, but I suggest you take a look at BioPerl's Bio::SeqEvolution::DNAPoint module. It does not take mutation rate as a parameter though. Rather, it asks what the lower bound of sequence identity with the original you want.
use strict;
use warnings;
use Bio::Seq;
use Bio::SeqEvolution::Factory;
my $seq = Bio::Seq->new(-seq => 'AAAAAAAAAA', -alphabet => 'dna');
my $evolve = Bio::SeqEvolution::Factory->new (
-rate => 2, # transition/transversion rate
-seq => $seq
-identity => 50 # At least 50% identity with the original
);
my #mutated;
for (1..1000) { push #mutated, $evolve->next_seq }
All 1000 mutated sequences will be stored in the #mutated array, their sequences can be accessed via the seq method.
In the event of a substitution, you want to exclude the current base from the possibilities:
my #other_bases = grep { $_ ne substr($init_seq, $i, 1) } #dna;
$base = #other_bases[int(rand 3)];
Also please see Mitch Wheat's answer for how to implement the substitution rate.
I don't know if I understand correctly but I'd do something like this (pseudocode):
digits = 'ATCG'
base = 'AAAAAAAAAA'
MAX = 1000
for i = 1 to len(base)
# check if we have to mutate
mutate = 1+rand(MAX) <= rate*MAX
if mutate then
# find current A:0 T:1 C:2 G:3
current = digits.find(base[i])
# get a new position
# but ensure that it is not current
new = (j+1+rand(3)) mod 4
base[i] = digits[new]
end if
end for