I'm trying to change charge values from MO (originating) calls in GSM TAP3.11 files, but it doesn't handle the needed
here i can access directly duration value but with charge value its different case as attached, im tring to change the charge value on (1) chargeDetail and (2) chargeDetail (first and second records in the ChargeDetailList in the screenshot below).
My background is only with python, this's the first time with perl. I use it because after searching I believe that only perl can handle TAP files. (see TAP3::Tap3edit)
$struct=$tap3->structure;
my $key;
# Will scan all the calls for MOC's.
foreach $key ( #{$struct->{'transferBatch'}->{'callEventDetails'} } ) {
foreach ( keys %{$key} ) {
if ( $_ eq "mobileOriginatedCall" )
{
$duration= $key->{$_}->{'basicCallInformation'}->{'totalCallEventDuration'};
delete $key->{$_}{'basicCallInformation'}{'basicServiceUsedList'}[0]{'chargeInformationList'}[0]{'chargeDetailList'}[0]{'charge'};
$key->{$_}{'basicCallInformation'}{'basicServiceUsedList'}[0]{'chargeInformationList'}[0]{'chargeDetailList'}[0]{'charge'}=$duration * 0.12 /0.6;
$new_charge_value = $key->{$_}{'basicCallInformation'}{'basicServiceUsedList'}[0]{'chargeInformationList'}[0]{'chargeDetailList'}[0]{'charge'}=$duration * 0.12 /0.6;
}
}
}
$tap3->encode("$tap_file") or die $tap3->error;
The exists() function in Perl is used to check whether an element in an given array or hash exists or not. This function returns 1 if the desired element is present in the given array or hash else returns 0.
$Tax_Rate = 3;
$Exchange_Rate = 3;
$Rate_Plan_Charge_Rate = 8;
my $key;
# Will scan all the calls for MOC's.
foreach $key ( #{$struct->{'transferBatch'}->{'callEventDetails'} } ) {
foreach ( keys %{$key} ) {
if ( $_ eq "mobileOriginatedCall" )
{
if (exists $key->{$_}->{'basicCallInformation'}->{'totalCallEventDuration'}){
$duration = $key->{$_}->{'basicCallInformation'}->{'totalCallEventDuration'};
if (exists $key->{$_}->{basicServiceUsedList}[0]{chargeInformationList}[0]{chargeDetailList}[0]){
$key->{$_}->{basicServiceUsedList}[0]{chargeInformationList}[0]{chargeDetailList}[0]{charge}=($duration * $Rate_Plan_Charge_Rate) / $Exchange_Rate;
}
if (exists $key->{$_}->{basicServiceUsedList}[0]{chargeInformationList}[0]{chargeDetailList}[1]){
$key->{$_}->{basicServiceUsedList}[0]{chargeInformationList}[0]{chargeDetailList}[1]{charge}=($duration * $Rate_Plan_Charge_Rate) / $Exchange_Rate;
}
$New_Charge = $key->{$_}->{basicServiceUsedList}[0]{chargeInformationList}[0]{chargeDetailList}[0]{charge};
if (exists $key->{$_}->{basicServiceUsedList}[0]{chargeInformationList}[0]{taxInformation}[0]){
$key->{$_}->{basicServiceUsedList}[0]{chargeInformationList}[0]{taxInformation}[0]{taxValue}=($New_Charge / $Tax_Rate);
}
if (exists $key->{$_}->{basicServiceUsedList}[0]{chargeInformationList}[0]{taxInformation}[1]){
$key->{$_}->{basicServiceUsedList}[0]{chargeInformationList}[0]{taxInformation}[0]{taxValue}=($New_Charge / $Tax_Rate);
}
}
}
}
}
Related
I'm looping through multiple objects, but the loop stops before going to the next object.
Created a loop with condition. If condition is met, it calls a ReduceEdge() function. Problem is it will only iterate once and not go to the next object and repeat the procedure.
global proc ReduceEdge()
{
polySelectEdgesEveryN "edgeRing" 2;
polySelectEdgesEveryN "edgeLoop" 1;
polyDelEdge -cv on;
}
string $newSel[] = `ls -sl`;
for($i = 0; $i < size($newSel); $i++)
{
select $newSel[$i];
int $polyEval[] = `polyEvaluate -e $newSel[$i]`;
int $temp = $polyEval[0];
for($k = 0; $k < $temp; $k++)
{
string $polyInfo[] = `polyInfo -fn ($newSel[$i] + ".f[" + $k + "]")`;
$polyInfo = stringToStringArray($polyInfo[$i]," ");
float $vPosX = $polyInfo[2];
float $vPosY = $polyInfo[3];
float $vPosZ = $polyInfo[4];
if($vPosX == 0 && $vPosY == 0 && $vPosZ == 1.0)
{
select ($newSel[$i] + ".e[" + $k + "]");
ReduceEdge();
}
}
}
Expected results:
If I select 4 cylinders, all their edges will reduce by half the current amount.
Actual results:
When 4 cylinders are selected, only one reduces down to half the edges. The rest stay the same.
Since my comment did help you out, I'll try and give a more thorough explanation.
Your first loop (with $i) iterates over each object in your selection. This is fine.
Your second loop (with $k) iterates over the number of edges for the current object in the loop. So far, so good. Though, I'm wondering if it would be more correct to loop of the number of faces...
Now you ask for an array of all face normals of the face at index $k at object $i, with string $polyInfo[] = `polyInfo -fn ($newSel[$i] + ".f[" + $k + "]")`;.
If you try and print the size and values in $polyInfo, you'll realize you have an array with one element, which is the face normal of the particular face you queried just before. Therefore, it will always be element 0, and not $i, which would increases with every iteration.
I have made a Python/PyMEL version of the script, which may be nice for you to see.
import pymel.core as pm
import maya.mel as mel
def reduceEdge():
mel.eval('polySelectEdgesEveryN "edgeRing" 2;')
mel.eval('polySelectEdgesEveryN "edgeLoop" 1;')
pm.polyDelEdge(cv=True)
def reducePoly():
selection = pm.ls(sl=True)
for obj in selection:
for i, face in enumerate(obj.f):
normal = face.getNormal()
if (normal.x == 0.0 and normal.y == 0.0 and normal.z == 1.0):
pm.select(obj + '.e[' + str(i) + ']')
reduceEdge()
reducePoly()
Using Text::Table or Text::ANSITable, or something similar...
If I have a two-dimensional array (which represents a grid of data), where the first row can be the column headers, how can I apply that data and format it into a command line grid with columns.
Something like this: PERL : How to create table from an array?
Except that the number of rows and columns is variable depending on the array setup and needs to automatically output as such.
Thanks
You can use Text::Table to accomplish this, as it handles variable numbers of rows and columns. Although the documentation leaves a lot to be desired, you can usually look to the test files or examples to show you how the library should actually get used. I've adapted example.pl to illustrate this:
table.pl
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Text::Table;
binmode STDOUT, ':utf8';
my ($rows, $cols) = #ARGV;
$rows ||= 5;
$cols ||= 7;
my #cols = map { "column " . $_} ( 1..$cols );
my $sep = \'│';
my $major_sep = \'║';
my $tb = Text::Table->new($sep, " Number ", $major_sep,
(map { +(" $_ ", $sep) } #cols)
);
my $num_cols = #cols;
for my $row (1..$rows) {
$tb->load([ "row $row", map { "r$row,c$_" } ( 1..$cols ) ]);
}
my $make_rule = sub {
my ($args) = #_;
my $left = $args->{left};
my $right = $args->{right};
my $main_left = $args->{main_left};
my $middle = $args->{middle};
return $tb->rule(
sub {
my ($index, $len) = #_;
return ('─' x $len);
},
sub {
my ($index, $len) = #_;
my $char =
( ($index == 0) ? $left
: ($index == 1) ? $main_left
: ($index == $num_cols+1) ? $right
: $middle
);
return $char x $len;
},
);
};
my $start_rule = $make_rule->(
{
left => '┌',
main_left => '╥',
right => '┐',
middle => '┬',
}
);
my $mid_rule = $make_rule->(
{
left => '├',
main_left => '╫',
right => '┤',
middle => '┼',
}
);
my $end_rule = $make_rule->(
{
left => '└',
main_left => '╨',
right => '┘',
middle => '┴',
}
);
print $start_rule, $tb->title,
(map { $mid_rule, $_, } $tb->body()), $end_rule;
output
perl table.pl 3 5
┌────────╥──────────┬──────────┬──────────┬──────────┬──────────┐
│ Number ║ column 1 │ column 2 │ column 3 │ column 4 │ column 5 │
├────────╫──────────┼──────────┼──────────┼──────────┼──────────┤
│row 1 ║r1,c1 │r1,c2 │r1,c3 │r1,c4 │r1,c5 │
├────────╫──────────┼──────────┼──────────┼──────────┼──────────┤
│row 2 ║r2,c1 │r2,c2 │r2,c3 │r2,c4 │r2,c5 │
├────────╫──────────┼──────────┼──────────┼──────────┼──────────┤
│row 3 ║r3,c1 │r3,c2 │r3,c3 │r3,c4 │r3,c5 │
└────────╨──────────┴──────────┴──────────┴──────────┴──────────┘
While modules offer easier control and features, if you only need to print it out as a grid
use warnings;
use strict;
use feature 'say';
my #ary = ([1..3], [10..12], [100..102]);
foreach my $row (#ary) {
printf "%7.3f ", $_ for #$row;
say ''
}
Prints
1.000 2.000 3.000
10.000 11.000 12.000
100.000 101.000 102.000
Choose your specifier (%7.3f above) accordingly to what data you have. See sprintf
If the first row is headers, shift it off of the array and print with the same width but using %s
my #ary = ([qw(one two three)], [1..3], [10..12], [100..102]);
printf "%7s ", $_ for #{shift #ary};
say '';
foreach my $row (#ary) {
printf "%7.3f ", $_ for #$row;
say ''
}
This prints the same as above but with (aligned) column names in the first row.
If "grid of data" means numeric data, then the code can discover whether there is a header line, with a reasonable assumption that the first line contains something non-numeric
use List::Util qw(any);
my $have_header = any { /[^0-9.+-]/ } #{$ary[0]};
what also assumes the absence of NaN and 1e02 or such on the first line (can be checked).
Better yet, use looks_like_number from Scalar::Util
use List::Util qw(any);
use Scalar::Util qw(looks_like_number);
my $have_header = any { not looks_like_number($_) } #{$ary[0]};
This uses Perl's internal sense of what a number is, and accounts for NaN and exponential notation, among other things.
If the program needs to find out the width of columns, or they differ a lot, there is more to do for a nice output since we need the maximum width of each column.
use warnings;
use strict;
use feature 'say';
use List::Util qw(max);
my $file = shift #ARGV || 'data.txt';
open my $fh, '<', $file or die "Can't open $file: $!";
my #ary = map { [ split ] } <$fh>;
my #maxw = (1) x #{$ary[0]};
for my $r (#ary) {
for (0..$#$r) {
my $len = length $r->[$_];
$maxw[$_] = $len if $len > $maxw[$_]
}
};
my $hdr = shift #ary;
printf "%$maxw[$_]s ", $hdr->[$_] for 0..$#$hdr;
say '';
for my $i (0..$#ary) {
printf "%-$maxw[$_].2f ", $ary[$i]->[$_] for 0..$#{$ary[$i]};
say '';
}
This expects numbers, except for the header. A few other reasonable assumptions are made.
With input data.txt file used to populate the array
one two three
1.12 1.1 12
1.00 10.00 102.00
the program prints
one two three
1.12 1.10 12.00
1.00 10.00 102.00
If there is a reason to "underline" the column names print this line right after headers
say join(" ", map { '-'x$maxw[$_] } 0..$#$hdr);
(However, tables are generally most readable when free of extra decorations.)
Note. If the numbers are computed in the program those scalars are used as numbers and the length of the string representing them in print should be queried as length sprintf "%s", $num. When they are read from a file they are taken as strings, what is used above for simplicity.
Note for another refinement. The above uses (fixed) 2 decimal places. That can be changed, if needed, so to first count the number of decimal places in input and print out accordingly. However, it is probably more sensible to decide on the uniform width, or at least fix the maximum width. (One doesn't want an accidental column with 16 decimal places, most useless!)
I have an AoA construct with four columns and many rows. Following is an example of data (input).
DQ556929 103480190 103480214 154943
DQ540839 103325247 103325275 2484
DQ566549 103322763 103322792 99
DQ699634 103322664 103322694 0
DQ544472 103322664 103322692 373
DQ709105 103322291 103322318 46
DQ705937 103322245 103322273 486
DQ699398 103321759 103321788 1211
DQ710151 103320548 103320577 692251
DQ548430 102628297 102628326 1
DQ558403 102628296 102628321 855795
DQ692476 101772501 101772529 481463
DQ544274 101291038 101291068 484047
DQ723982 100806991 100807020 1
DQ709023 100806990 100807020 3
DQ712307 100806987 100807014 0
DQ709654 100806987 100807012 571051
DQ707370 100235936 100235962 1481849
I want to group and write into a file all the row elements (sequentially).
Conditions are if column four values less than 1000 and minimum two values are next to each other, group them else if the value less than 1000 and lies between the values more than 1000 treat them as single and append separately in the same file and the values which are more than 1000 also write as a block but with out affecting the order of the 2nd and third column.
This file is output of my previous program, now for this I have tried implementing my hands but getting some weird results. Here is my chunk of code, but non functional. Guys I need just help if i am executing my logic well here, I am open for any comments as a beginner. And also correct me anywhere.
my #dataf= sort{ $a->[1]<=> $b->[1]} #data;
#dataf=reverse #dataf;
for(my $i>=0;$i<=$#Start;$i++)
{
print "$sortStart[$i]\n";
my $diff = $sortStart[$i] - $sortStart[$i+1];
$dataf[$i][3]= $diff;
# $IDdiff{$ID[$i]}=$diff;
}
#print Dumper(#dataf);
open (CLUST, ">> ./clustTest.txt" );
for (my $k=0;$k<=$#Start;$k++)
{
for (my $l=0;$l<=3;$l++)
{
# my $tempdataf = shift $dataf[$k][$l];
# print $tempdataf;
if ($dataf[$k][3]<=1000)
{
$flag = 1;
do
{
print CLUST"----- Cluster $clustNo -----\n";
print CLUST"$dataf[$k][$l]\t";
if ($dataf[$k][3]<=1000)
{
$flag1 = 1;
}else {$flag1=0;}
$clustNo++;
}until($flag1==0 && $data[$k][3] > 1000);
if($flag1==0 && $data[$k][3] > 1000)
{
print CLUST"Singlet \n";
print CLUST"$dataf[$k][$l]\t";
next;
}
#print CLUST"$dataf[$k][$l]\t"; ##IDdiff
}
print CLUST"\n";
}
}
Expected output in file:
Singlets
DQ556929 103480190 103480214 154943
DQ540839 103325247 103325275 2484
Cluster1
DQ566549 103322763 103322792 99
DQ699634 103322664 103322694 0
DQ544472 103322664 103322692 373
DQ709105 103322291 103322318 46
DQ705937 103322245 103322273 486
Singlets
DQ699398 103321759 103321788 1211
DQ710151 103320548 103320577 692251
DQ548430 102628297 102628326 1
DQ558403 102628296 102628321 855795
DQ692476 101772501 101772529 481463
DQ544274 101291038 101291068 484047
Cluster2
DQ723982 100806991 100807020 1
DQ709023 100806990 100807020 3
DQ712307 100806987 100807014 0
Singlets
DQ709654 100806987 100807012 571051
DQ707370 100235936 100235962 1481849
This seems to produce the expected output. I'm not sure I understood the specification correctly, so there might be errors and edge cases.
How it works: it remembers what kind of section it's currently outputting ($section, Singlet or Cluster). It accumulates lines in the #cluster array if they belong together, when an incompatible line arrives, the cluster is printed and a new one is started. If the cluster to print has only one member, it's treated as a singlet.
#!/usr/bin/perl
use warnings;
use strict;
my $section = q();
my #cluster;
my $cluster_count = 1;
sub output {
if (#cluster > 1) {
print "Cluster$cluster_count\n";
$cluster_count++;
} elsif (1 == #cluster) {
print $section = 'Singlet', "s\n" unless 'Singlet' eq $section;
}
print for #cluster;
#cluster = ();
}
my $last = 'INF';
while (<>) {
my ($id, $from, $to, $value) = split;
if ($value > 1000 || 1000 < abs($last - $from)) {
output();
} else {
$section = 'Cluster';
}
push #cluster, $_;
$last = $to;
}
output();
I have a little script where I want to return an array of Dates between two dates.
Problem is that the scalar that is being added is by reference, how do I store a copy or the derefferenced value
#!/usr/bin/perl
use strict;
use warnings;
use DateTime;
my $now = DateTime->today;
my $start_date = DateTime->today;
$start_date = $start_date->subtract( days => 45 );
my #dates;
while ( $start_date <= $now ) {
push #dates, $start_date;
$start_date->add( days => 1 );
}
my $date;
foreach (#dates) {
print $_->ymd('/'), "\n";
}
You can clone the object as you push it onto the array, like this
my #dates;
while ( $start_date <= $now) {
push #dates, $start_date->clone;
$start_date->add( days => 1 );
}
foreach (#dates) {
print $_->ymd('/'), "\n";
}
but that is wasteful if you want only ever want the YMD string from each date. You can just push that instead
my #dates;
while ( $start_date <= $now) {
push #dates, $start_date->ymd('/');
$start_date->add( days => 1 );
}
print "$_\n" for #dates;
You can set up the array more simply by working on the elements of the array itself, as follows
my #dates = (DateTime->today);
unshift #dates, $dates[0]->clone->subtract(days => 1) for 1 .. 45;
But in the end it is neater, and probably faster, to use the Time::Piece to do the same thing. It is a core module, and so shouldn't need installing if your copy of perl is at all recent, it is far smaller than DateTime, and is probably faster
use strict;
use warnings;
use Time::Piece;
use Time::Seconds 'ONE_DAY';
my #dates = map { localtime() - $_ * ONE_DAY } reverse 0 .. 45;
print $_->ymd('/'), "\n" for #dates;
output
2014/07/24
2014/07/25
2014/07/26
2014/07/27
2014/07/28
2014/07/29
2014/07/30
2014/07/31
2014/08/01
2014/08/02
2014/08/03
2014/08/04
2014/08/05
2014/08/06
2014/08/07
2014/08/08
2014/08/09
2014/08/10
2014/08/11
2014/08/12
2014/08/13
2014/08/14
2014/08/15
2014/08/16
2014/08/17
2014/08/18
2014/08/19
2014/08/20
2014/08/21
2014/08/22
2014/08/23
2014/08/24
2014/08/25
2014/08/26
2014/08/27
2014/08/28
2014/08/29
2014/08/30
2014/08/31
2014/09/01
2014/09/02
2014/09/03
2014/09/04
2014/09/05
2014/09/06
2014/09/07
Update
To store strings in the array instead of Time::Piece objects, you could write this instead
use strict;
use warnings;
use Time::Piece;
use Time::Seconds 'ONE_DAY';
my $today = localtime;
my #dates = map { ($today - $_ * ONE_DAY)->ymd('/') } reverse 0 .. 45;
print "$_\n" for #dates;
The output is identical to that of the previous program.
apparently there is a function for it called clone()
so this
push(#dates, $start_date);
changes into
push(#dates, $start_date->clone);
This is a loop and the array does not get overwritten, it just grows.
for ( $j=0; $j <=$#just_ecps ; $j++){
print "$just_ecps[$j]\n";
for ($x=0; $x<=$#folder_dates ; $x++){
my $archivo_histo = "/home/ha2_d11/data/ibprod/archive/$folder_dates[$x]/$just_ecps[$j]/ghistogram.gz";
next unless (-r $archivo_histo);
open(FILEHANDLE, "gunzip -c $archivo_histo |") or die ("could not open file $archivo_histo");
while (<FILEHANDLE>) {
if ($_ =~ /ave:\s+(\d+\.\d+)\s/){
push ( #ecp_average , $1);
sleep 1;
}
print "#ecp_average\n";
}
}
In every instance it is the last three values that are valid, everything before it is a duplicate. I need to get rid of the duplicates and just keep the last three values.
Eislnd1
0.00420743 0.00414601 0.0044511
Eislnd2
0.00420743 0.00414601 0.0044511 0.00303575 0.00309721 0.00302753
Eislnd3
0.00420743 0.00414601 0.0044511 0.00303575 0.00309721 0.00302753 0.0031753 0.00324729 0.00295381
Eislnd4
0.00420743 0.00414601 0.0044511 0.00303575 0.00309721 0.00302753 0.0031753 0.00324729 0.00295381 0.00324191 0.00344244 0.00311481
You need to clear the array for every file:
open(FILEHANDLE, "gunzip -c $archivo_histo |") or die ...
#ecp_average = ();
while (<FILEHANDLE>) {
...
}
At some point you'll want to read up on lexically-scoped variables (i.e. the my declaration)
but for now this should work.
Things to note that will help improve this code:
use strict; use warnings;
Consider using for my $just_ecp ( #just_ecps ) { ... } instead of the C-style construct
Defining an averaging subroutine ( sub avg { sum(#_) / #_ } ) and using it ( avg( #ecp ) ) is a more intuitive way to compute averages instead of mucking around with array lengths. All it takes one line!