Kode Perl di bawah ini merupakan kode untuk melakukan edit Spectrum atau RAAC dengan Graphical User Interface (GUI).
Untuk GUI saya menggunakan Perl/Tk, yang pada Ubuntu bisa diinstall dengan perintah:
sudo apt-get install perl-tk
Terdapat dua format untuk RAAC yakni Time-RAAC dan Offset RAAC yakni Text Omega dengan posisi Time, Offset dan RAAC pada lokasi tertentu. Program ini memilki kemampuan membaca dan menulis dengan format tersebut (lihat gambar di bawah ini:
Format Omega Time-RAAC
. 
Format Offset-RAAC
Sedangkan Spectrum merupakan kolom:
Format Spectrum: kolom pertama (frekuensi), kedua (amplitudo), ketiga (fasa).
Berikut adalah tampilan GUI untuk melakukan edit spectrum. Kurva merah adalah spectrum input, mouse pick (titik-titik magenta) merupakan guide untuk interpolasi. Antara mouse-pick tersebut di-interpolasi dengan metoda spline atau linear dengan moving average smoothing. Banyaknya sample diantara dua mouse-pick ditentukan dengan spline-steps.
GUI dengan Spline
GUI dengan Linear Interpolation dan Moving Average Smoothing
Berikut adalah Kode Perl GUI di atas:
#!/usr/bin/perl
use Tk;
use Tk::ProgressBar;
my $mw = MainWindow->new( -title => 'RAAC and Spectrum Editor Ver 1.0 Processing Unit Kuwait Oil Company ' );
$mw->withdraw();
$mw->transient();
$mw->Popup();
my $titiks = [];
push(@$titiks, []);
my $menu_bar = $mw->Menu;
my $vw = $mw->vrootwidth/3;
my $vh = $mw->vrootheight/2;
### Progress Bar
my $percent_done=0;
my $Progress = $mw->ProgressBar(-width =>5,-from => 0,-to => 100,-blocks => 50, -colors => [0, 'green', 50, 'yellow' , 80, 'red',],-variable => \$percent_done)->pack(-fill => 'x');
### canvas
$mw->configure( -menu => $menu_bar );
my $canvas = $mw->Canvas(-cursor => "crosshair", -width => $vw+300, -height => $vh+300, -background => "white"); ###change 100>300
### Menu
my $file_mb = $menu_bar->cascade( -label => '~File', -tearoff => 0 );
$file_mb->command( -label => 'Open T-RAAC', -underline => 0, -command => \&f_open );
$file_mb->command( -label => 'Open O-RAAC', -underline => 0, -command => \&f_open_oraac);
$file_mb->command( -label => 'Open Spectrum', -underline => 0, -command => \&f_open_spec);
$file_mb->separator;
$file_mb->command( -label => 'Exit', -underline => 1, -command => sub{exit} );
$canvas->Tk::bind("<Button-1>", [ \&append_point, Ev('x'), Ev('y') ]);
my $help_mb = $menu_bar->cascade( -label => '~About', -tearoff => 0 );
$help_mb->command( -label => 'About', -underline => 0, -command => \&f_help );
### button
my $lab = $mw -> Label(-text=>"Spline Steps: ");
my $scl = $mw->Entry( -width => 8, -textvariable => '200');
my $spline = $mw->Button(-width => 8, -height => 1,-text => 'Run Spline',-command => \&fspline);
my $lab2 = $mw -> Label(-text=>"Smooth Window: ");
my $scl2 = $mw->Entry( -width => 8, -textvariable => '20');
my $spline2 = $mw->Button(-width => 8, -height => 1,-text => 'Run Linear',-command => \&flinear);
my $clear = $mw->Button(-width => 8, -height => 1,-text => 'Re-Pick',-command => \&fclear);
my $export1 = $mw->Button(-width => 15, -height => 1,-text => 'Print Time-RAAC',-command => \&fexport1);
my $export2 = $mw->Button(-width => 15, -height => 1,-text => 'Print Offset-RAAC',-command => \&fexport2);
my $export3 = $mw->Button(-width => 15, -height => 1,-text => 'Print Spectum',-command => \&fexport3);
my $exit = $mw->Button(-width => 8, -height => 1,-text => 'Exit',-command => [$mw => 'destroy']);
### packing
$canvas->pack;
$lab->pack(-side=>'left');
$scl->pack(-side=>'left');
$spline->pack(-side=>'left');
$lab2->pack(-side=>'left');
$scl2->pack(-side=>'left');
$spline2->pack(-side=>'left');
$clear->pack(-side=>'left');
$export1->pack(-side=>'left');
$export2->pack(-side=>'left');
$export3->pack(-side=>'left');
$exit->pack(-side=>'left');
MainLoop;
### pick points
sub f_help {
$mw-> messageBox(-title => 'About', -message => 'RAAC and Spectrum Editor Ver 1.00 contact: Agus Abdullah, aguabdullah@kockw.com for help ', -type=>'ok');
}
### read time raac format input
sub f_open {
$canvas->delete('plot0');
$canvas->delete('plot1');
$canvas->delete('plot2');
$canvas->delete('plot3');
$canvas->delete('plot4');
$canvas->delete('plot5');
$canvas->delete('plot6');
$canvas->delete('plot7');
$canvas->delete('plot8');
$canvas->delete('plot9');
### delete vars if any
@x=();
@y=();
@b=();
@sesu1=();
@spl=();
@xclick=();
@yclick=();
$ax2=();
$ax=();
$ay=();
$nopoints=();
$ax2o=();
$ayo=();
@xori=();
@yori=();
$percent_done=();
@data2=();
$xori2=();
@hasil=();
@data1=();
$dx=();
$dz=();
@dza=();
@dzt=();
@dzt2=();
@dzt3=();
@time=();
@raac=();
$kadal=();
$dhor=();
$dxy=();
@bx1=();
@row=();
@spec=();
@xspl=();
@yspl=();
@a1=();
@a2=();
@data=();
@avea=();
@xtra=();
@fbave=();
@yspl2=();
$main::coords=();
#delete objects
my $filename = $mw->getOpenFile( -title => 'Open File:', -initialdir => '.' );
open (FILE, $filename);
while (<FILE>) {
chomp;
if (/RACC/)
{
$s=$_;
$time1=substr($s,11,4);
$raac1=substr($s,15,6);
$time2=substr($s,26,4);
$raac2=substr($s,30,6);
$time3=substr($s,41,4);
$raac3=substr($s,45,6);
$time4=substr($s,56,4);
$raac4=substr($s,60,6);
push @x,$time1,$time2,$time3,$time4;
push @y,$raac1,$raac2,$raac3,$raac4;
}
}
### convert x,y into canvas pixel coordinates
for my $i (0..$#x-1)
{
$x1[$i]=(($x[$i]-min(@x))*($vw/(max(@x)-min(@x))))+100; #change 50 > 100
$y1[$i]=(($y[$i]-max(@y))*($vh/(min(@y)-max(@y))))+200; #change 50 > 200
$canvas->createText($x1[$i],$y1[$i], -text=>'x', fill=> 'red',-tags=>'plot0'); #plot curve
push @b, $x1[$i], $y1[$i];
push @bx1,$x1[$i];
}
close( FILE );
### plot time raac input
$canvas->createLine(\@b, -fill=> 'red',-tags=>'plot1'); #plot curve
$canvas->createLine(40,20, $vw+280,20,$vw+280,$vh+280, 40, $vh+280, 40,20, -fill=> 'grey',-tags=>'plot2'); #plot box ###change 80 > 280
$dhor=(max(@x)-min(@x))/10;
for my $i (0..11)
{
$canvas->createLine((($dhor*$i-min(@x))*($vw/(max(@x)-min(@x))))+100,20,(($dhor*$i-min(@x))*($vw/(max(@x)-min(@x))))+100,$vh+280, -fill=> 'grey', -dash => '-',-tags=>'plot3'); #plot grid
$canvas->createText((($dhor*$i-min(@x))*($vw/(max(@x)-min(@x))))+100,10, -text => sprintf("%.0f", $dhor*$i),-tags=>'plot4'); #plot box grid
}
$dxy=(max(@y)-min(@y))/5;
for my $i (0..6)
{
$canvas->createLine(40, ((min(@y)+($i*$dxy)-max(@y))*($vh/(min(@y)-max(@y))))+200, $vw+280, ((min(@y)+($i*$dxy)-max(@y))*($vh/(min(@y)-max(@y))))+200, -fill=> 'grey', -dash => '-',-tags=>'plot5');
$canvas->createText(20,((min(@y)+($i*$dxy)-max(@y))*($vh/(min(@y)-max(@y))))+200 ,-text => sprintf("%.2f", min(@y)+($i*$dxy)) ,-tags=>'plot6'); #plot grid
}
print 'Time RAAC data loaded...Start to pick using Mouse Button 1 !',"\n";
}
### read offset raac format input
sub f_open_oraac {
### delete vars if any
@x=();
@y=();
@b=();
@sesu1=();
@spl=();
@xclick=();
@yclick=();
$ax2=();
$ax=();
$ay=();
$nopoints=();
$ax2o=();
$ayo=();
@xori=();
@yori=();
$percent_done=();
@data2=();
$xori2=();
@hasil=();
@data1=();
$dx=();
$dz=();
@dza=();
@dzt=();
@dzt2=();
@dzt3=();
@time=();
@raac=();
$kadal=();
$dhor=();
$dxy=();
@bx1=();
@row=();
@spec=();
@xspl=();
@yspl=();
@a1=();
@a2=();
@data=();
@avea=();
@xtra=();
@fbave=();
@yspl2=();
$main::coords=();
$canvas->delete('plot0');
$canvas->delete('plot1');
$canvas->delete('plot2');
$canvas->delete('plot3');
$canvas->delete('plot4');
$canvas->delete('plot5');
$canvas->delete('plot6');
$canvas->delete('plot7');
$canvas->delete('plot8');
$canvas->delete('plot9');
my $filename = $mw->getOpenFile( -title => 'Open File:', -initialdir => '.' );
open (FILE, $filename);
while (<FILE>) {
chomp;
if (/RACF/)
{
$s=$_;
$offset=substr($s,36,4);
push @x, $offset;
}
if (/RACC/)
{
$s=$_;
$raac=substr($s,15,6);
$sesu=substr($s,11,4); ### what the hack is this?
push @y, $raac;
push @sesu1, $sesu;
}
}
###### desired for line plot
for my $i (0..$#x-1)
{
$x1[$i]=(($x[$i]-min(@x))*($vw/(max(@x)-min(@x))))+100; #change 50 > 100
$y1[$i]=(($y[$i]-max(@y))*($vh/(min(@y)-max(@y))))+200; #change 50 > 200
$canvas->createText($x1[$i],$y1[$i], -text=>'x', fill=> 'red',-tags=>'plot0'); #plot curve
push @b, $x1[$i], $y1[$i];
push @bx1,$x1[$i];
}
close( FILE );
### plot offset raac input
$canvas->createLine(\@b, -fill=> 'red',-tags=>'plot1'); #plot curve
$canvas->createLine(40,20, $vw+280,20,$vw+280,$vh+280, 40, $vh+280, 40,20, -fill=> 'grey',-tags=>'plot2'); #plot box ###change 80 > 280
$dhor=(max(@x)-min(@x))/10;
for my $i (0..11)
{
$canvas->createLine((($dhor*$i-min(@x))*($vw/(max(@x)-min(@x))))+100,20,(($dhor*$i-min(@x))*($vw/(max(@x)-min(@x))))+100,$vh+280, -fill=> 'grey', -dash => '-',-tags=>'plot3'); #plot grid
$canvas->createText((($dhor*$i-min(@x))*($vw/(max(@x)-min(@x))))+100,10, -text => sprintf("%.0f", $dhor*$i),-tags=>'plot4'); #plot box grid
}
$dxy=(max(@y)-min(@y))/5;
for my $i (0..6)
{
$canvas->createLine(40, ((min(@y)+($i*$dxy)-max(@y))*($vh/(min(@y)-max(@y))))+200, $vw+280, ((min(@y)+($i*$dxy)-max(@y))*($vh/(min(@y)-max(@y))))+200, -fill=> 'grey', -dash => '-',-tags=>'plot5');
$canvas->createText(20,((min(@y)+($i*$dxy)-max(@y))*($vh/(min(@y)-max(@y))))+200 ,-text => sprintf("%.2f", min(@y)+($i*$dxy)) ,-tags=>'plot6'); #plot grid
}
print 'Offset RAAC data loaded...Start to pick using Mouse Button 1 !',"\n";
}
### read spectrum
sub f_open_spec {
### delete vars if any
@x=();
@y=();
@b=();
@sesu1=();
@spl=();
@xclick=();
@yclick=();
$ax2=();
$ax=();
$ay=();
$nopoints=();
$ax2o=();
$ayo=();
@xori=();
@yori=();
$percent_done=();
@data2=();
$xori2=();
@hasil=();
@data1=();
$dx=();
$dz=();
@dza=();
@dzt=();
@dzt2=();
@dzt3=();
@time=();
@raac=();
$kadal=();
$dhor=();
$dxy=();
@bx1=();
@row=();
@spec=();
@xspl=();
@yspl=();
@a1=();
@a2=();
@data=();
@avea=();
@xtra=();
@fbave=();
@yspl2=();
$main::coords=();
$canvas->delete('plot0');
$canvas->delete('plot1');
$canvas->delete('plot2');
$canvas->delete('plot3');
$canvas->delete('plot4');
$canvas->delete('plot5');
$canvas->delete('plot6');
$canvas->delete('plot7');
$canvas->delete('plot8');
$canvas->delete('plot9');
my $filename = $mw->getOpenFile( -title => 'Open File:', -initialdir => '.' );
open (FILE, $filename);
while( <FILE> ) {
chomp;
my @row = split;
push @spec, \@row;
}
close( FILE );
for my $i (0..$#spec)
{
push @x, $spec[$i][0];
push @y, $spec[$i][1];
}
### convert x,y into canvas pixel coordinates
for my $i (0..$#x-1)
{
$x1[$i]=(($x[$i]-min(@x))*($vw/(max(@x)-min(@x))))+100; #change 50 > 100
$y1[$i]=(($y[$i]-max(@y))*($vh/(min(@y)-max(@y))))+200; #change 50 > 200
$canvas->createText($x1[$i],$y1[$i], -text=>'x', fill=> 'red',-tags=>'plot0'); #plot curve
push @b, $x1[$i], $y1[$i];
push @bx1,$x1[$i];
}
close( FILE );
$canvas->createLine(\@b, -fill=> 'red',-tags=>'plot1'); #plot curve
$canvas->createLine(40,20, $vw+280,20,$vw+280,$vh+280, 40, $vh+280, 40,20, -fill=> 'grey',-tags=>'plot2'); #plot box ###change 80 > 280
$dhor=(max(@x)-min(@x))/10;
for my $i (0..11)
{
$canvas->createLine((($dhor*$i-min(@x))*($vw/(max(@x)-min(@x))))+100,20,(($dhor*$i-min(@x))*($vw/(max(@x)-min(@x))))+100,$vh+280, -fill=> 'grey', -dash => '-',-tags=>'plot3'); #plot grid
$canvas->createText((($dhor*$i-min(@x))*($vw/(max(@x)-min(@x))))+100,10, -text => sprintf("%.0f", $dhor*$i),-tags=>'plot4'); #plot box grid
}
$dxy=(max(@y)-min(@y))/5;
for my $i (0..6)
{
$canvas->createLine(40, ((min(@y)+($i*$dxy)-max(@y))*($vh/(min(@y)-max(@y))))+200, $vw+280, ((min(@y)+($i*$dxy)-max(@y))*($vh/(min(@y)-max(@y))))+200, -fill=> 'grey', -dash => '-',-tags=>'plot5');
$canvas->createText(20,((min(@y)+($i*$dxy)-max(@y))*($vh/(min(@y)-max(@y))))+200 ,-text => sprintf("%.2f", min(@y)+($i*$dxy)) ,-tags=>'plot6'); #plot grid
}
print 'Spectrum data loaded...Start to pick using Mouse Button 1 !',"\n";
}
### pick points
sub append_point {
my ($canvas, $x, $y) = @_;
my ($canvx, $canvy) = ($canvas->canvasx($x), $canvas->canvasy($y));
$canvas->createOval($canvx-3, $canvy-3, $canvx+3, $canvy+3, -tags => 'point', -fill => 'blue' ,-tags=>'plot7');
my $id=0;
$main::coords=$main::coords."$x,$y,";
my $command="\$id=\$canvas->createLine($main::coords -width=>1, -fill=>'blue',";
$command=$command."-tags=>\"plot9\")";
eval $command;
push @xclick,$canvx;
push @yclick,$canvy;
}
### spline
sub fspline {
$ax2=();
$ax=();
$ay=();
@spl=();
$ax2o=();
$ayo=();
@xori=();
@yori=();
$percent_done=();
@xspl=();
@yspl=();
@a1=();
@a2=();
@data=();
@avea=();
@xtra=();
@fbave=();
@yspl2=();
$main::coords=();
$canvas->delete('plot8');
$canvas->delete('plot9');
if ( min(@xclick) > min(@bx1))
{
print 'Splining is in progress be patient...However X coord of the first pick must be less than the minimum of X coord input, Re-pick',"\n";
}elsif ( max(@xclick) < max(@bx1))
{
print 'Splining is in progress be patient...However X coord of the last pick must be greater than the maximum of X coord input, Re-pick!',"\n";
} else
{
print 'Splining is in progress be patient...picks are OK',"\n";
}
$dnum=$scl->get();
$nopoints=$#xclick+1;
for($i=0;$i<$nopoints;$i++)
{
$a[$i] = $yclick[$i];
}
for($i=0;$i<$nopoints;$i++)
{
$h[$i] = $xclick[$i+1]-$xclick[$i];
}
for($i=1;$i<$nopoints-1;$i++)
{
$al[$i] = ($yclick[$i+1]-$yclick[$i])*3/$h[$i] - ($yclick[$i]-$yclick[$i-1])*3/$h[$i-1];
}
$l[0] = 1;
$mu[0] = 0;
$z[0] = 0;
for($i=1;$i<$nopoints-1;$i++)
{
$l[$i] = 2*($xclick[$i+1]-$xclick[$i-1])-$h[$i-1]*$mu[$i-1];
$mu[$i] = $h[$i]/$l[$i];
$z[$i] = ($al[$i]-$h[$i-1]*$z[$i-1])/$l[$i];
}
$l[$nopoints-1] = 1;
$z[$nopoints-1] = 0;
$c[$nopoints-1] = 0;
for($j=$nopoints-1;$j>=0;$j--)
{
$c[$j] = $z[$j]-$mu[$j]*$c[$j+1];
$b[$j] = ($yclick[$j+1]-$yclick[$j])/$h[$j]-$h[$j]*($c[$j+1]+2*$c[$j])/3;
$d[$j] = ($c[$j+1]-$c[$j])/(3*$h[$j]);
}
$i=0;
for($i=0;$i<$nopoints-1;$i++)
{
for($j=0;$j<$dnum;$j++)
{
$ax2 = ($xclick[$i+1]-$xclick[$i])/$dnum*$j+$xclick[$i];
$ax = $ax2-$xclick[$i];
$ay = $a[$i]+$b[$i]*$ax+$c[$i]*$ax**2+$d[$i]*$ax**3;
push @spl,$ax2,$ay;
$ax2o=(($ax2-100)/($vw/(max(@x)-min(@x))))+min(@x);
$ayo=(($ay-200)/($vh/(min(@y)-max(@y))))+max(@y);
push @xori,$ax2o;
push @yori,$ayo;
}
$percent_done = $i/(($nopoints-2)/100);
$mw->update;
}
$canvas->createLine(\@spl, -fill=> 'blue' ,-tags=>'plot8');
print 'Splining is done!',"\n";
}
#linear interpolation
sub flinear {
$percent_done=();
$a=();
$h=();
$al=();
$l=();
$mu=();
$z=();
$c=();
$b=();
$d=();
$ax2=();
$ax=();
$ay=();
@xspl=();
@yspl=();
@avea=();
$ave=();
@fbave=();
$fbave=();
@data=();
@a1=();
@a2=();
@xtra=();
@yspl2=();
@spl=();
$ax2o=();
$ayo=();
@xori=();
@yori=();
$main::coords=();
$canvas->delete('plot8');
$canvas->delete('plot9');
if ( min(@xclick) > min(@bx1))
{
print 'Splining is in progress be patient...However X coord of the first pick must be less than the minimum of X coord input, Re-pick',"\n";
}elsif ( max(@xclick) < max(@bx1))
{
print 'Splining is in progress be patient...However X coord of the last pick must be greater than the maximum of X coord input, Re-pick!',"\n";
} else
{
print 'Splining is in progress be patient...picks are OK',"\n";
}
$dnum=$scl->get();
$nopoints=$#xclick+1;
for($i=0;$i<$nopoints;$i++)
{
$a[$i] = $yclick[$i];
}
for($i=0;$i<$nopoints;$i++)
{
$h[$i] = $xclick[$i+1]-$xclick[$i];
}
for($i=1;$i<$nopoints-1;$i++)
{
$al[$i] = ($yclick[$i+1]-$yclick[$i])*3/$h[$i] - ($yclick[$i]-$yclick[$i-1])*3/$h[$i-1];
}
$l[0] = 0;
$mu[0] = 0;
$z[0] = 0;
for($i=1;$i<$nopoints-1;$i++)
{
$l[$i] = 2*($xclick[$i+1]-$xclick[$i-1])-$h[$i-1]*$mu[$i-1];
$mu[$i] = $h[$i]/$l[$i];
$z[$i] = ($al[$i]-$h[$i-1]*$z[$i-1])/$l[$i];
$l[$i] =0;
$mu[$i] = 0;
$z[$i]=0;
}
$l[$nopoints-1] = 0;
$z[$nopoints-1] = 0;
$c[$nopoints-1] = 0;
for($j=$nopoints-1;$j>=0;$j--)
{
$c[$j] = $z[$j]-$mu[$j]*$c[$j+1];
$b[$j] = ($yclick[$j+1]-$yclick[$j])/$h[$j]-$h[$j]*($c[$j+1]+2*$c[$j])/3;
$d[$j] = ($c[$j+1]-$c[$j])/(3*$h[$j]);
}
$i=0;
for($i=0;$i<$nopoints-1;$i++)
{
for($j=0;$j<$dnum;$j++)
{
$ax2 = ($xclick[$i+1]-$xclick[$i])/$dnum*$j+$xclick[$i];
$ax = $ax2-$xclick[$i];
$ay = $a[$i]+$b[$i]*$ax+$c[$i]*$ax**2+$d[$i]*$ax**3;
push @xspl,$ax2;
push @yspl,$ay;
}
$percent_done = $i/(($nopoints-2)/100);
$mw->update;
}
$window=$scl2->get();
#### padding
for ( $i = 0; $i < $window; $i++ )
{
push @a1,$yspl[0];
push @a2,$yspl[$#yspl];
}
push @data,@a1,@yspl,@a2;
##### moving average ####################
for ($i=0; $i<=$#data; $i++)
{
for ($k=0; $k<=$window; $k++)
{
push @{$fbave[$i]},$data[$i+$k];
}
$ave[$i]=mean(@{$fbave[$i]});
push @avea, $ave[$i];
}
push @xtra, $_ for 1..($window/2);
push @xtra,@avea;
for ($i=$window; $i<=$#data-$window; $i++)
{
push @yspl2, $xtra[$i];
}
for ($i=0; $i<=$#xspl; $i++)
{
push @spl,$xspl[$i],$yspl2[$i];
$ax2o[$i]=(($xspl[$i]-100)/($vw/(max(@x)-min(@x))))+min(@x);
$ayo[$i]=(($yspl2[$i]-200)/($vh/(min(@y)-max(@y))))+max(@y);
push @xori,$ax2o[$i];
push @yori,$ayo[$i];
}
$canvas->createLine(\@spl, -fill=> 'blue',-tags=>'plot8');
print 'Linear Interp and Smoothing is done!',"\n";
}
### min max subroutine
sub max {
splice(@_, ($_[0] > $_[1]) ? 1 : 0, 1);
return ($#_ == 0) ? $_[0] : max(@_);
}
sub min {
splice(@_, ($_[0] > $_[1]) ? 0 : 1, 1);
return ($#_ == 0) ? $_[0] : min(@_);
}
### clear for re-pick
sub fclear {
$canvas->delete('plot7');
$canvas->delete('plot8');
$canvas->delete('plot9');
### delete vars
@spl=();
@xclick=();
@yclick=();
$ax2=();
$ax=();
$ay=();
$nopoints=();
$ax2o=();
$ayo=();
@xori=();
@yori=();
$percent_done=();
@data2=();
$xori2=();
@hasil=();
@data1=();
$dx=();
$dz=();
@dza=();
@dzt=();
@dzt2=();
@dzt3=();
@time=();
@raac=();
$kadal=();
$dhor=();
$dxy=();
@row=();
@spec=();
@xspl=();
@yspl=();
@a1=();
@a2=();
@data=();
@avea=();
@xtra=();
@fbave=();
@yspl2=();
$main::coords=();
}
### export time raac
sub fexport1{
print 'Printing...!',"\n";
@time=();
@raac=();
@data2=();
@dzt=();
@dzt2=();
@dzt3=();
$kadal=();
@hasil=();
$main::coords=();
for my $i (0..$#xori)
{
$xori2[$i]= int($xori[$i]) + ($xori[$i] != int($xori[$i])); ## rounded up
push @{$hasil[$i]},$xori2[$i],$yori[$i];
}
### find uniq values
my %seen;
my @data2 = grep { !$seen{$_->[0]}++ } @hasil;
### find match X coords
for my $i (0..$#x)
{
push @{$data1[$i]},$x[$i],$y[$i];
}
for my $i (0..$#data1) #no row slave
{
for my $j (0..$#data2) #no row master
{
$dx[$i]=($data1[$i][0]-$data2[$j][0])*($data1[$i][0]-$data2[$j][0]); #key1 match
$dz[$i]=$dx[$i]; #distance
push @dza,$dz[$i];
}
push @dzt,$dza[minindex(\@dza)];
push @dzt2,$data2[minindex(\@dza)][0]; #get data col 1
push @dzt3,$data2[minindex(\@dza)][1]; #get data col 2
@dza=();
}
for my $i (0..$#data1-1)
{
push @time, $data1[$i][0];
push @raac, $dzt3[$i];
}
###Printing Department ;)
$kadal=($#time-1)/4;
my $mn = int($kadal) + ($kadal != int($kadal));
for $k (0..$mn)
{
printf "%s", "RACC";
{
for $i (1..4)
{
if ($raac[$i+$k*4-1] > 0) # search for exist raac
{
if ($i == 1 && $k==0)
{
printf "%11d",$time[$i+$k*4-1];
}
elsif ($i == 1 && $k==1 ) #
{
printf "%11d",$time[$i+$k*4-1];
}
elsif ($i == 1 )
{
printf "%11d",$time[$i+$k*4-1];
}
else
{
printf "%9d",$time[$i+$k*4-1];
}
if ($raac[$i+$k*4-1] < 1)
{
printf "%6.4f",$raac[$i+$k*4-1];
}else
{
printf "%6.3f",$raac[$i+$k*4-1];
}
}
}
print "\n";
}
}
}
sub mean { # mean of values in an array
my $sum = 0 ;
foreach $x (@_) {
$sum += $x ;
}
return $sum/@_ ;
}
#### export offset raac
sub fexport2{
@time=();
@raac=();
@data2=();
@dzt=();
@dzt2=();
@dzt3=();
$kadal=();
@hasil=();
$main::coords=();
print 'Printing...!',"\n";
for my $i (0..$#xori)
{
$xori2[$i]= int($xori[$i]) + ($xori[$i] != int($xori[$i])); ## round up
push @{$hasil[$i]},$xori2[$i],$yori[$i];
}
####find uniq values
my %seen;
my @data2 = grep { !$seen{$_->[0]}++ } @hasil;
###find match X
for my $i (0..$#x)
{
push @{$data1[$i]},$x[$i],$y[$i];
}
for my $i (0..$#data1) #no row slave
{
for my $j (0..$#data2) #no row master
{
$dx[$i]=($data1[$i][0]-$data2[$j][0])*($data1[$i][0]-$data2[$j][0]); #key1 match
$dz[$i]=$dx[$i]; #distance
push @dza,$dz[$i];
}
push @dzt,$dza[minindex(\@dza)];
push @dzt2,$data2[minindex(\@dza)][0]; #get data col 1
push @dzt3,$data2[minindex(\@dza)][1]; #get data col 2
@dza=();
}
for my $i (0..$#data1)
{
push @time, $data1[$i][0];
push @raac, $dzt3[$i];
}
###Printing Department
for $i (0..$#time)
{
printf "%s", "RACF SOURCE_DETECT_DIST";
printf "%17d",$time[$i];
printf "%5s","1";
printf "%5s","1";
print "\n";
printf "%s", "RACC";
printf "%11d",$sesu1[$i];
if ($raac[$i] < 1)
{
printf "%5.4f",$raac[$i];
}else
{
printf "%6.3f",$raac[$i];
}
print "\n";
}
}
### export spectrum
sub fexport3{
$mn=();
print 'Print Spectrum...',"\n";
my $mn = int($#xori/$#x) + (($#xori/$#x) != int($#xori/$#x));
for ($i = 0; $i <= $#xori; $i += $mn)
{
if ($xori[$i] < 0)
{
}else
{
printf "%7.2f",$xori[$i];
printf "%5s",',';
printf "%10.3f",$yori[$i];
printf "%5s",',';
printf "%5.0f",'0';
printf "%5s",',';
print "\n";
}
}
}
sub minindex {
my( $aref, $idx_min ) = ( shift, 0 );
$aref->[$idx_min] < $aref->[$_] or $idx_min = $_ for 1 .. $#{$aref};
return $idx_min;
}
No comments:
Post a Comment