Create alias for conditions in Drools Decision table - jboss

Attached is my decision table, where in I'm using sv2.SV202_CompMedProcedId.get("SV202-02") several times in my condition. Is there any way that we can create an alias for sv2.SV202_CompMedProcedId.get("SV202-02") (for example, S) and use that alias in my condition instead of using the entire line every time?
CONDITION
sv2.SV202_CompMedProcedId.get(""SV202-02"").Value >= '70010' && sv2.SV202_CompMedProcedId.get(""SV202-02"").Value <= '76499' || sv2.SV202_CompMedProcedId.get(""SV202-02"").Value >= '76506' && sv2.SV202_CompMedProcedId.get(""SV202-02"").Value <= '76999' || sv2.SV202_CompMedProcedId.get(""SV202-02"").Value >= '77001' && sv2.SV202_CompMedProcedId.get(""SV202-02"").Value <= '77032' || sv2.SV202_CompMedProcedId.get(""SV202-02"").Value >= '77051' && sv2.SV202_CompMedProcedId.get(""SV202-02"").Value <= '77059' || sv2.SV202_CompMedProcedId.get(""SV202-02"").Value >= '77071' && sv2.SV202_CompMedProcedId.get(""SV202-02"").Value <= '77084' || sv2.SV202_CompMedProcedId.get(""SV202-02"").Value >= '77261' && sv2.SV202_CompMedProcedId.get(""SV202-02"").Value <= '77999' || sv2.SV202_CompMedProcedId.get(""SV202-02"").Value >= '78000' && sv2.SV202_CompMedProcedId.get(""SV202-02"").Value <= '79999'
where sv2 is the object and SV2 is the class

Yes, you can use an alias. Change your condition to:
$s : sv2.SV202_CompMedProcedId.get("SV202-02").Value >= '70010' && $s <= '76499' ||
$s >= '76506' && $s <= '76999' ||
$s >= '77001' && $s <= '77032' ||
$s >= '77051' && $s <= '77059' ||
$s >= '77071' && $s <= '77084' ||
$s >= '77261' && $s <= '77999' ||
$s >= '78000' && $s <= '79999'

If this is frequent enough you might write and import a static Java (!) function:
public boolean isInRanges( Comparable value, Comparable... bounds ){
for( int i = 0; i < bounds.length; i += 2 ){
if( bounds[i].compareTo(value) <= 0 &&
value.compareTo(bounds[i+1]) <= 0 ) return true;
}
return false;
}
The simple call is obvious.
You can't use a DRL function: AFAIK, the vararg notation isn't implemented (but check).

Related

Issues with Perl program

use strict;
use warnings;
use FindBin;
use lib $FindBin::Bin;
use genNumeros;
my #palabra;
open (my $ARCHIVO, '<', "palabras.txt") or warn ("No se encontro el archivo palabras.txt, $!");
while (my $palabra = <$ARCHIVO>) {
chomp $palabra;
push #palabra, $palabra;
}
close $ARCHIVO;
my $palabraAleatoria = $palabra[genNumeros::crearNumero()];
print"$palabraAleatoria";
<>;
The genNumeros module has this code:
package genNumeros;
use strict;
use warnings;
use Math::Complex;
my $seed = time();
my $a = $seed / 5;
my $c = $seed - 7;
my $x = $seed;
my $m = sqrt($seed % 574) + $seed;
my $numAleatorio;
sub generadorMultiplicativo{
$numAleatorio = ((($a*$x) + $c) % $m);
$x = $numAleatorio;
}
my $letra;
my $residuo;
sub crearNumero{
generadorMultiplicativo();
$residuo = $x/$m;
if($residuo < 0.0384615384615385){
$letra = 1;
}
if($residuo > 0.0384615384615385 && $residuo < 0.076923076923077){
$letra = 2;
}
if($residuo > 0.076923076923077 && $residuo < 0.1153846153846154){
$letra = 3;
}
if($residuo > 0.1153846153846154 && $residuo < 0.1538461538461538){
$letra = 4;
}
if($residuo > 0.1538461538461538 && $residuo < 0.1923076923076923){
$letra = 5;
}
if($residuo > 0.1923076923076923 && $residuo < 0.2307692307692308){
$letra = 6;
}
if($residuo > 0.2307692307692308 && $residuo < 0.2692307692307692){
$letra = 7;
}
if($residuo > 0.2692307692307692 && $residuo < 0.3076923076923077 ){
$letra = 8;
}
if($residuo > 0.3076923076923077 && $residuo < 0.3461538461538462){
$letra = 9;
}
if($residuo > 0.3461538461538462 && $residuo < 0.3846153846153846){
$letra = 10;
}
if($residuo > 0.3846153846153846 && $residuo < 0.4230769230769231){
$letra = 11;
}
if($residuo > 0.4230769230769231 && $residuo < 0.4615384615384615){
$letra = 12;
}
if($residuo > 0.4615384615384615 && $residuo < 0.5){
$letra = 13;
}
if($residuo > 0.4615384615384615 && $residuo < 0.5384615384615385){
$letra = 14;
}
if($residuo > 0.5384615384615385 && $residuo < 0.5769230769230769){
$letra = 15;
}
if($residuo > 0.5769230769230769 && $residuo < 0.6153846153846154){
$letra = 16;
}
if($residuo > 0.6153846153846154 && $residuo < 0.6538461538461538){
$letra = 17;
}
if($residuo > 0.6538461538461538 && $residuo < 0.6923076923076923){
$letra = 18;
}
if($residuo > 0.6923076923076923 && $residuo < 0.7307692307692308){
$letra = 19;
}
if($residuo > 0.7307692307692308 && $residuo < 0.7692307692307692){
$letra = 20;
}
if($residuo > 0.7692307692307692 && $residuo < 0.8076923076923077){
$letra = 21;
}
if($residuo > 0.8076923076923077 && $residuo < 0.8461538461538462){
$letra = 22;
}
if($residuo > 0.8461538461538462 && $residuo < 0.8846153846153846){
$letra = 23;
}
if($residuo > 0.8846153846153846 && $residuo < 0.9230769230769231){
$letra = 24;
}
if($residuo > 0.9230769230769231 && $residuo < 0.9615384615384615){
$letra = 25;
}
if($residuo > 0.9615384615384615 && $residuo < 1){
$letra = 26;
}
return $letra;
}
1;
The thing is, that when i execute the .pl, it only closes up, i've already checked the "palabras.txt" and it has 27 words, the perl -c and perl -wc says that the syntax is OK, the #INC with perl -V finishes with a '.', I really don't know what's happening, I'm on ActivePerl 5.20 in Windows 10.
Your code is working, but it's just not displaying the number before the window closes.
STDOUT (printing to the screen) is often line buffered. This means it will only display the line when it sees a newline. For example...
print "SLEEP!!!";
sleep 2;
print " AWAKE!!!\n"'
This will sleep for two seconds and then print SLEEP!!! AWAKE!!! all at once.
Try print "$palabraAleatoria\n";
For more detail, read Suffering From Buffering.
It seems like you're making your own random number generator? Perl already has one, rand(), and it will use a better seed than the time in seconds, and a better algorithm. rand takes a range of numbers to produce. rand(27) will give a number from 0 to 27 exclusive (so 0 to 26.9999). To use it to pick an element out of an array, use the size of the array.
my $random_idx = int rand #palabra;
print "$palabra[$random_idx]\n";
This also avoids having to hard code the number of elements in your array into your code.
Using rand eliminates the need for the big if chain, but let's talk about it anyway. It can be better written as an if/elsif starting at the top.
if( $residuo > 0.9615384615384615 ) {
return 26;
}
elsif( $residuo > 0.9230769230769231 ) {
return 25;
}
...and so on...
This avoids having to duplicate the range twice meaning less opportunities for typos. An if/elsif is more efficient, it doesn't have to check every condition, it will stop as soon as a condition is met. Returning immediately is also simpler and more efficient than using an intermediate return variable.
All those magic numbers makes one wonder why they're magical. Once you notice that 0.0384615384615385 is 1/26 you can use that instead.
if( $residuo > 25/26 ) {
return 26;
}
elsif( $residuo > 24/26 ) {
return 25;
}
...and so on...
Replacing the magic numbers with fractions makes it easier to read and clearer what's going on. Once that happens it becomes clear this can be replaced with some simple math.
return $residuo * 26 + 1;

Issues executing with ActivePerl 5.20

I have a program which uses a module, located at the same folder that the executable but when I execute it it only closes.
use strict;
use warnings;
use genLetras;
for my $k (1 .. 30 ) {
for my $j (1 .. 30 ) {
genLetras::generarLetra();
$matriz[$k][$j] = genLetras::generarLetra();
}
}
for my $i (1 .. 30 ) {
for my $j (1 .. 30 ) {
print "[$matriz[$k][$j]] ";
}
print "\n";
}
<>;
That is the code of the executable.
An this one is the modules's one
use strict;
use warnings;
use Math::Complex;
my $seed = time();
my $a = $seed / 5;
my $c = $seed - 7;
my $x = $seed;
my $m = sqrt($seed % 574) + $seed;
my $numAleatorio;
sub generadorMultiplicativo{
$numAleatorio = ((($a*$x) + $c) % $m);
$x = $numAleatorio;
}
my $letra;
my $residuo;
sub generarLetra{
for my $i(1..30){
generadorMultiplicativo();
$residuo = $x/$m;
if($residuo < 0.0384615384615385 ){
$letra = 'A';
}
if($residuo > 0.0384615384615385 && $residuo < 0.076923076923077){
$letra = 'B';
}
if($residuo > 0.076923076923077 && $residuo < 0.1153846153846154){
$letra = 'C';
}
if($residuo > 0.1153846153846154 && $residuo < 0.1538461538461538){
$letra = 'D';
}
if($residuo > 0.1538461538461538 && $residuo < 0.1923076923076923){
$letra = 'E';
}
if($residuo > 0.1923076923076923 && $residuo < 0.2307692307692308){
$letra = 'F';
}
if($residuo > 0.2307692307692308 && $residuo < 0.2692307692307692){
$letra = 'G';
}
if($residuo > 0.2692307692307692 && $residuo < 0.3076923076923077 ){
$letra = 'H';
}
if($residuo > 0.3076923076923077 && $residuo < 0.3461538461538462){
$letra = 'I';
}
if($residuo > 0.3461538461538462 && $residuo < 0.3846153846153846){
$letra = 'J';
}
if($residuo > 0.3846153846153846 && $residuo < 0.4230769230769231){
$letra = 'K';
}
if($residuo > 0.4230769230769231 && $residuo < 0.4615384615384615){
$letra = 'L';
}
if($residuo > 0.4615384615384615 && $residuo < 0.5){
$letra = 'M';
}
if($residuo > 0.4615384615384615 && $residuo < 0.5384615384615385){
$letra = 'N';
}
if($residuo > 0.5384615384615385 && $residuo < 0.5769230769230769){
$letra = 'O';
}
if($residuo > 0.5769230769230769 && $residuo < 0.6153846153846154){
$letra = 'P';
}
if($residuo > 0.6153846153846154 && $residuo < 0.6538461538461538){
$letra = 'Q';
}
if($residuo > 0.6538461538461538 && $residuo < 0.6923076923076923){
$letra = 'R';
}
if($residuo > 0.6923076923076923 && $residuo < 0.7307692307692308){
$letra = 'S';
}
if($residuo > 0.7307692307692308 && $residuo < 0.7692307692307692){
$letra = 'T';
}
if($residuo > 0.7692307692307692 && $residuo < 0.8076923076923077){
$letra = 'U';
}
if($residuo > 0.8076923076923077 && $residuo < 0.8461538461538462){
$letra = 'V';
}
if($residuo > 0.8461538461538462 && $residuo < 0.8846153846153846){
$letra = 'W';
}
if($residuo > 0.8846153846153846 && $residuo < 0.9230769230769231){
$letra = 'X';
}
if($residuo > 0.9230769230769231 && $residuo < 0.9615384615384615){
$letra = 'Y';
}
if($residuo > 0.9615384615384615 && $residuo < 1){
$letra = 'Z';
}
return;
}
}
I've already compiled both with perl-c , perl -V and all said it was correct.
I'm using ActivePerl 5.20 on Windows 10
Four things to consider here:
The module's filename must be genLetras.pm.
The main script must find it. Do as #ikegami suggested in his answer and add
use FindBin qw( $RealBin );
use lib $RealBin;
before the use genLetras; line.
The module must end with some true value else the loader will complain.
Add the line
1;
as the very last line to your module.
The module needs a line package genLetras; as the first line. Add that.
Further notes:
Module names – by convention – usually start with an uppercase letter, like GenLetras, because
lowercase letters are reserved for pragmas (like e.g. warnings or strict).
I use FindBin usually like this:
use FindBin;
use lib $FindBin::Bin;
but that's more a matter of taste.
The <>; at the end of your main script normally is useless. I think you used it to prevent your Perl window from
closing immediately but wait for you to press ENTER instead.
That's ok then.
I wonder why perl -c script.pl didn't show any errors. At my PC it did.
During your testing, you probably set the Current Directory to be the directory in which the script resides. The module could be found because the module search paths (#INC) includes ..
When it fails, the Current Directory was probably set to some other directory. The module couldn't be found because #INC didn't contain the directory in which it resides.
Add the following to add the script's directory to #INC:
use FindBin qw( $RealBin );
use lib $RealBin;

mIRC - Pausing hash table

Code;
on *:text:!ticket *:#:{
var %hash $+(ticket.,#)
if $istok(%owner,$nick,32) && $2 == on && !$hget(%hash) {
hmake %hash
msg # Ticket now is open. Use !ticket <point> to join.
}
elseif $2 isnum && $2 > 0 && $hget(%hash) {
var %topic $+(#,.,$nick), %point $readini(points.ini,%topic,points)
if %point >= $2 {
var %p $calc(%point - $2)
writeini points.ini %topic points %p
var %i $hget(%hash,0).item, %t $calc(%i + $2)
while %i < %t { inc %i | hadd %hash %i $nick }
msg # $nick $+ , You bought $2 ticket, you now have %p points
}
else { msg # $nick Sorry, you only have %point points }
}
elseif ($nick isop #) && $2 == roll && $hget(%hash) {
var %i $rand(1,$hget(%hash,0).data)
msg # The winner is $hget(%hash,%i).data $+ .
//I want to pause the raffle here so no more people can buy tickets but it sill keeps the entrys
}
elseif ($nick isop #) && $2 == over && $hget(%hash) {
hfree %hash
}
elseif ($nick isop #) && $2 == go && $hget(%hash) {
//I want people to be allowed to by more tickets and have the old tickets still count
}
}
It's all good. I just need to be able to pause the raffle but not get rid of the entries and then be able to resume the raffle. Comments in code to explain
this is the part you want
on *:text:!ticket *:#:{
var %hash $+(ticket.,#)
if $istok(%owner,$nick,32) && $2 == on && !$hget(%hash) {
hmake %hash
msg # Ticket now is open. Use !ticket <point> to join.
}
elseif $2 isnum && $2 > 0 && $hget(%hash) {
var %topic $+(#,.,$nick), %point $readini(points.ini,%topic,points)
if %point >= $2 && !%pause {
// here script will check if %pause is not set, so script will run normal, if yes, it wont work
var %p $calc(%point - $2)
writeini points.ini %topic points %p
var %i $hget(%hash,0).item, %t $calc(%i + $2)
while %i < %t { inc %i | hadd %hash %i $nick }
msg # $nick $+ , You bought $2 ticket, you now have %p points
}
else { msg # $nick Sorry, you only have %point points }
}
elseif ($nick isop #) && $2 == roll && $hget(%hash) {
var %i $rand(1,$hget(%hash,0).data)
msg # The winner is $hget(%hash,%i).data $+ .
inc -u10 %pause
//10 is time in seconds you can choose whatever time you want, so in this way, no one can buy tickets for 10 seconds
}
elseif ($nick isop #) && $2 == over && $hget(%hash) {
hfree %hash
}
elseif ($nick isop #) && $2 == go && $hget(%hash) {
unset %pause
// if someone typed "roll" and then you want to buy more tickes, typing "go" will just unset %pause
// you can set %pause for more time, or just an unlimmited time
}
}
i didnt test it yet

Shipping Handling Charge CGI/Perl

I want to add a flat $25 handling fee for Alaska (AK) and Hawaii (HI) - my test breaks when I add the states and flat fee to the shipping matrix below. Can someone point me in the right direction?
my $totalPounds = sprintf("%.2f",($totalWeight / 16));
#my $shipping = &getShipUPS($totalPounds, $zip, $shipType);
if ($subtotal <= 24.99) {$shipping = '10.95';}
elsif (($subtotal > 24.99) && ($subtotal <= 74.99)) {$shipping = '13.95';}
elsif (($subtotal > 74.99) && ($subtotal <= 149.99)) {$shipping = '14.95';}
elsif ($subtotal >= $150) {$shipping = '18.95';}
elsif ($state eq 'HI','AK') ($subtotal <= 24.99) {$shipping = '10.95'+'25.00';}
elsif ($state eq 'HI','AK') (($subtotal > 24.99) && ($subtotal <= 74.99)) {$shipping = '13.95'+'25.00';}
elsif ($state eq 'HI','AK') (($subtotal > 74.99) && ($subtotal <= 149.99)) {$shipping = '14.95'+'25.00';}
elsif ($state eq 'HI','AK') ($subtotal >= $150) {$shipping = '18.95'+'25.00';}else
$shipping = sprintf("%.2f", $shipping);
my $total = $subtotal + $tax + $shipping;
$subtotal = sprintf("%.2f", $subtotal);
$total = sprintf("%.2f", $total);
You cannot use multiple parameters with eq like this
$state eq 'HI','AK'
You need to do
$state eq 'HI' or $state eq 'AK'
ALso, you cannot put another parenthesis after the first after elsif like this
elsif ($state eq 'HI','AK') ($subtotal >= $150)
You need to do
elsif ( ($state eq 'HI' or $state eq 'AK') or ($subtotal >= $150) )
# ^---- main parantheses -------^
Of course, the smarter choice might be to use a hash
%extra_charges = ( AK => 25,
HI => 25,
# etc
);
...
$subtotal += $extra_charges{$state}; # assuming no missing states
The if-else logic is also all kinds of redundant. This ought to be the equivalent of your code:
if ($subtotal <= 24.99) { $shipping = '10.95' }
elsif ($subtotal <= 74.99) { $shipping = '13.95' }
elsif ($subtotal <= 149.99) { $shipping = '14.95' }
else { $shipping = '18.95' }
if ($state eq 'AK' or $state eq 'HI') { $shipping += 25 }
Those meandering forests of ifs are enough to make one dizzy, and most of them were not required. If a value is not less than or equal to 24.99, it must be bigger than 24.99, so no need to double check that.
That code is a total mess, has multiple syntax errors, and violates DRY.
It would be best to first calculate the basic shipping fee, depending on the subtotal. In a second step you add the $25 charge if the state is Hawaii or Alaska:
my #shipping_fees = (
# max subtotal => fee
[ 24.99 => 10.95 ],
[ 74.99 => 13.95 ],
[ 149.99 => 14.95 ],
[ inf => 18.95 ],
);
my %extra_fees_per_state = (
AK => 25.00,
HI => 25.00,
);
Then:
my $shipping;
for my $shipping_fee (#shipping_fees) {
my ($max, $fee) = #$shipping_fee;
if ($subtotal <= $max) {
$shipping = $fee;
last;
}
}
if (defined( my $extra = $extra_fees_per_state{$state})) {
$shipping += $extra;
}

How can I count number of logical conditions used in if,elseif or while in Perl?

i have a while,if,elseif statements in a file with multipe conditions inside
it... it is a C language...the format is mentioned below is standard for all the
multiple conditions.So no worries about the indendation.The only problem is to check how
many conditions are there and list as per output format that i have described....
eg if my C file have a code...
while(
condition1 &&
condition2 ||
condition3
)
{
#statements;
}
i want to count how many conditions are there inside the while and my output should be
of like this...
while(
1 condition1 &&
2 condition2 ||
3 condition3
)
{
#statements;
}
i have written the code and it works fine for simple one.. my code....
open(A,"e:\\a\\a.txt")or die;
#a=<A>;
close(A);
$count=1;
for($i=0;$i<scalar#a;$i++)
{
if($a[$i]=~m/while/g)
{
$line=$i;
until($a[$line]=~/\{/g)
{
if($a[$line]=~/(.*)[\&&\||]/g){print"$count $a[$line]";$count++;}
elsif($a[$line]=~/\(.*\)[\&&\||]/g){print"$count $a[$line]";$count++;}
else{print$a[$line];}
$line++;
}
}
last if($a[$line]=~/\{/g);
}
but for complicated conditions like
while(
(
condition1 &&
condition2 &&
condition3
) ||
(
condition4 ||
condition5 &&
condition6
)
{
#statements;
}
am getting the output like
while(
(
1 condition1 &&
2 condition2 &&
condition3
3 ) ||
(
4 condition4 ||
5 condition5 &&
condition6
)
which is not desired.... my intension is to count all the conditions regarding however complicated it is..... please help me...
desired output may be
while(
(
1 condition1 &&
2 condition2 &&
3 condition3
) ||
(
4 condition4 ||
5 condition5 &&
6 condition6
)
)
since it has used 6 conditions inside... hence forth for any cases.
What language is this? Are full parsers available for this language? If so, I suggest you use them. If not, I think you'll have a hard time solving this problem reliably. Your approach relies on the specific way the programmer formatted his code.
Right when you solved your problem for your example, somebody will throw the following at you:
while(
( condition1 && condition2)
&& condition3 )
||
( condition4 || condition5
&& condition6 )
{
#statements;
}
If you insist on writing your own mock-up parser, then I would suggest the following:
Do not parse line-wise. Feel free to read line-wise. But don't parse each line separately.
Extract the contents of the matching set of parenthesis after the while. The clue here is "matching". Run "perldoc -q matching" and have a look at the first Perl FAQ entry coming up about parsing matching/nesting parenthesis.
When you have the code contained in the parenthesis, try to extract the number of operands to the logical operators by splitting on the logical ops.
Despair if the operands (conditionX) may contain strings which contain, for example "&&".
Tools you may find useful in order of sophistication:
perldoc -q nesting as mentioned above
The Text::Balanced module (Available out of the box with any perl version >= 5.8)
The Parse::Yapp and Parse::RecDescent parser generator modules from CPAN. Yapp is underdocumented, but doesn't suffer from some pathological problems P::RD suffers from.
Parse::Eyapp presumably combines the good points of both of the above modules.
I hope you can learn something from this.
use 5.010;
use Text::Balanced qw(extract_bracketed);
my $logical_keywords = join '|', qw(while if);
my $logical_operators = join '|', map {quotemeta} qw(|| &&);
my $code = do { local $/; <DATA>; }; # slurp the whole thing into a scalar
for my $chunk (split /$logical_keywords \s+/msx, $code) {
# a chunk is the (...)... part after an »if« or »while«
# until the next »if« or »while«
next unless $chunk =~ /\A [(]/msx;
# discard preceding junk
my $balanced_parentheses = extract_bracketed($chunk, '()');
# only the (...) part after an »if« or »while«
my #conditions = split /(?<=$logical_operators)/msx, $balanced_parentheses;
say scalar(#conditions). " conditions were found. And here's the enumerated code block.";
my $index = 0;
for my $condition (#conditions) {
$index++;
my ($pre, $post) = $condition =~ /( (?: [(] | \s )* ) (.*)/msx;
print "$pre $index $post";
}
say; # force a new line
}
__DATA__
# start of the source code.
while(
condition1 &&
condition2 ||
condition3
)
{
#statements;
}
# some other code
while(
(
condition1 &&
condition2 &&
condition3
) ||
(
condition4 ||
condition5 &&
condition6
)
)
{
#statements;
}
(some (nested (nonsense))) || (
);
if (
(
condition1 &&
condition2
) ||
((
condition3
) ||
(
condition4 &&
condition5
))
)
{
((these parentheses do not count) &&
neither does this.
);
}
Output:
3 conditions were found. And here's the enumerated code block.
(
1 condition1 &&
2 condition2 ||
3 condition3
)
6 conditions were found. And here's the enumerated code block.
(
(
1 condition1 &&
2 condition2 &&
3 condition3
) ||
(
4 condition4 ||
5 condition5 &&
6 condition6
)
)
5 conditions were found. And here's the enumerated code block.
(
(
1 condition1 &&
2 condition2
) ||
((
3 condition3
) ||
(
4 condition4 &&
5 condition5
))
)
For this I think I'd go with something like PPI, which often does a good enough job of parsing Perl source, and certainly is going to do a better job of most people starting from scratch.
You might also look at Devel::Cover, which includes such information in its report as part of its conditional coverage metric.