现在的位置: 首页 > 综合 > 正文

optimization_new.pl

2014年11月20日 ⁄ 综合 ⁄ 共 15289字 ⁄ 字号 评论关闭

 

#!perl

#**************************************************************************************#
#-------------------------------------------------------------------------------------#
#     Optimization_new.pl
#-------------------------------------------------------------------------------------#
# This script is modifying the files for optimization (cases 1 to 5) with the new names (e.g. s01_01_arc)
# To run the script, four ways are available
# 1. No arguments : the script provide a list of the available sgf files to modify.
#     the name of the modified file will be (name_of_original_file)_o.sgf
# 2. One argument : the name of the original file (the name of the modified file will be as above)
# 3. Two arguments : the name of the original file and the modified file
#      (to overwrite the orginal file just put it twice as arguments)
# 4. Three arguments : same as before. The last argument can be either "-order" or "-copy"
#       if "-order" is used only the ordering of elements is done
#       if "-copy" is used only the copy of elements is done (Block OPTIMISATION_OBJECTS)   
#
# Important : The model should not contain any container
#**************************************************************************************#

$|=10;

print "\n****** Beginning of the reprocessing of TC for optimisation ******\n";

PROCESS_ARGUMENTS: {
if ($#ARGV == 0) {
 $file=$ARGV[0]; #the first and only argument is the name of the file to modify
 $new_file = $file; #the name of the file to write the modified file in
 $new_file =~ s%\.sgf%_o\.sgf%;
} elsif ($#ARGV == 1) { #two arguments, the first one being the initial file and the second one the name of the modified file
  ($file,$new_file) = ($ARGV[0],$ARGV[1]);
} elsif ($#ARGV == 2) { #three arguments, same as above and the third one should be "-tr"
  unless ($ARGV[2] == ("-order"|"-copy")) {die "Error, 3rd argument should be \"-order\" or \"-copy\" or nothing \n";}
  ($file,$new_file,$operation) = @ARGV;
} elsif ($#ARGV > 2) { die "Too many arguments in the command line ($!)\n"; #if there are more than 3 arguments
} else {
 my @list_sgf=glob "*.sgf";
 print "\n** Please, enter the name of the file **\nThe available files are : \n","-"x 20,"\n";
 $n_file=0;  #the number to identify the file where the user can choose from
 foreach (@list_sgf) {++$n_file;print "$n_file.: $_\n";}
 print "-"x 20,"\nChoose the file you want as an argument: ";
 $file = $list_sgf[<STDIN>-1];
 $new_file = $file; #the name of the file to write the modified file in
 $new_file =~ s%\.sgf%_o\.sgf%;
  } #end of else
} #end of block PROCESS_ARGUMENTS

$log_file = $file; $log_file =~ s%(\w+)\.sgf%$1_optim.log%; #name of the log file
#open LOG, ">$log_file" or die "Error while opening log file $log_file ($!)\n"; #for_debug

ORDER_OBJECTS:{ ORDER_OBJECTS; #order by name of objects (lexical order) => to improve
 if ($operation eq "-copy") {last ORDER_OBJECTS;} #the 3rd argument is -copy so no order will be made
 print LOG "*"x 59,"\n","*"x 25,"  ORDER  ","*"x 25,"\n","*"x 59,"\n"; #to print in the log file
 open SGF, "<$file" or die "Error while opening $file ($!)\n";
 print "-Opening of original file\n";
 @temporary_file=(); #temporary buffer to copy in the file
 %objects=(); #hash table with all the objects in the sgf
 $line=0;
 while (<SGF>) {
  ++$line;
#  print "Line : $_"; #for_debug
  if (/<node.*name="(.*)" type="(.*)" visible/) { #node different from synchronous layer
   my $object_name=$1;my $type=$2; #define the type and the name
   #print "*Hello, object_name: $object_name object_type: $type*\n"; #for_debug
   if ($type =~ /container/) { die "Container object found ($!)\n"; #there shouldn't be any container in the model
   } elsif ($type eq "synchronous_layer") {
    print LOG "Synchronous Layer found (line $line)\n"; #for_debug
   }else  {
    $spec_obj="$_"; #the specification of the object is reset to the first line read of the object
    print LOG "Object found : $object_name (line $line)\n"; #for_debug
    while (<SGF>) {
     ++$line;
     $spec_obj=$spec_obj . "$_"; #we add the line in the temporary object
     if (m%<\/node>%) { last;}#the end of the node is reached
     #print "Line read ($line): $_"; #for_debug
    } #end of while
   $_=""; #we delete the content of the line
#   print LOG "--$object_name--\n","*"x 70,"\n",$spec_obj,"\n"; #for_debug
   $objects{$object_name}=$spec_obj;
   #print "Temp object:",@temp_obj,"\n"; #for_debug
   } #else {die "PROBLEM OF NODE ($!)\n";}#end of elsif
  }elsif (m%<\/node>%) { #end of symbology layer => we put the objects in order
   $line=$_; #copy the content of the line to copy it later
   @objects_list=sort(keys %objects); #sort the objects in order
   print LOG "**The sorted objects are:\n";foreach (@objects_list) {print LOG "$_\n";} #for_debug
   foreach $obj (@objects_list) {push(@temporary_file,$objects{$obj});} #end of foreach object
   $_=$line; #copy back the content of the line into $_
  } #end of elsif
  push(@temporary_file,$_);#copy the lines in the temporary file
 } #end of while
 open SGF_MODIF, ">$new_file" or die "Error while opening $new_file for modificiation ($!)\n";
 print SGF_MODIF @temporary_file;print "**Save ordered sgf in $new_file\n"; #for_debug
 print LOG "*"x 59,"\n","*"x 22," END OF ORDER ","*"x 23,"\n","*"x 59,"\n"; #to print in the log file
}#end of block ORDER_OBJECTS

OPTIMISATION_OBJECTS: { #last OPTIMISATION_OBJECTS;
if ($operation eq "-order") {last OPTIMISATION_OBJECTS;} #the 3rd argument is -order so no copy will be made
#print "\n\n","*"x 59,"\n","*"x 24," COPY-PASTE ","*"x 24,"\n","*"x 59,"\n"; #to print in the log file
if ($operation eq "-copy") { #if there is no ordering before
 open SGF, "<$new_file" or die "Error while opening $new_file ($!)\n";
 print "-Opening of original file\n";
}else {
 close SGF_MODIF; #closing of the file is needed only if it has been used before
 print "-Close the writing of the ordered sgf-\n-Open it again to read the content-\n";
 open SGF, "<$new_file" or die "Error while opening $new_file ($!)\n"; #we take in this case the file ordered as an input
} #end of if/else
$temp_file=""; #temporary buffer
$temp_group=""; #temporary buffer for a group of objects (three sequences)
$line=0; #for the number of the line being read
$number=0; #the number of the object
READ:  $read_line="";
  while ($read_line = <SGF>) {
  ++$line; #increment the number of the line
  if ($read_line =~ /<node.*name="(s(\d{2})[\w\-]+)" type="(.*)" visible/) {$object_name=$1;$n_seq=$2;last;}
  $temp_file = $temp_file . $read_line;
   #copy the line in the buffer file except if it's the one with the first object of the first sequence
  unless (defined ($read_line)) {
   die "No sequence found (line $line)\n"; } # if the end of the file is not reached
 } #end of until : first object of the first sequence has been found
# print "At line $line, we have read this text so far:\n $temp_file"; #for_debug
# print "First object $object_name: found line $line (sequence $n_seq) \n"; #for_debug
 #print "Read line: $read_line"; #for_debug
 OBJECTS: {if ($n_seq =~ /(01|04|07|10|13)/) { #the sequences being used as models
   $temp_seq = "$read_line"; #reset the buffer for the sequence with the value of the line just found
   while ($read_line = <SGF>) {
    ++$line;
    #print $read_line; #for_debug
    if (($read_line =~ /<node name=\"(s(\d+)_\d+_[\w\-]+)\"/)and($2 > $n_seq)) { #we reached the next sequence
     $object_name=$1;
     last; #we exit the loop
    } #end of if node
    $temp_seq=$temp_seq . $read_line; #copy the line in the buffer $temporary_object
    unless (defined ($read_line)) { die "Error (no new sequence found (line $line)";} #protective_code
   } #end of while
#   print "*"x 62,"\n *We found object $object_name at line $line\n","*"x 62,"\n"; #for_debug
#   print LOG "*"x 30,"Sequence number $n_seq: ","*"x 30,"\n$temp_seq","*"x 70,"\n"; #for_debug
   #copy, modify and past the sequences#
   $temp_group = $temp_group . $temp_seq; #add temp_object in the $temp_group
   $temp_group = $temp_group . &modif_block($temp_seq,"x",1); #add the object translated once in $temp_group
   $temp_group = $temp_group . &modif_block($temp_seq,"x",2); #add the object translated twice in $temp_groupmy
   #end of processing
   
   $next_numb=$n_seq+3; #the next number of 1st object in the next group
   until (($read_line =~ /<node name=\"(s(\d+)_\d+_[\w\-]+)\"/)and($2 == $n_seq + 3)) { #we reached the next sequence
    unless (defined ($read_line= <SGF>)) { die "Error (no new sequence found (line $line)";} #protective_code
    ++$line;
   } #end of until
   $read_line =~ /<node name=\"(s(\d+)_\d+_[\w\-]+)\"/;$object_name=$1;$n_seq=$2;
#   print "*"x 62,"\n We found object $object_name at line $line\n","*"x 62,"\n"; #for_debug
   redo OBJECTS; #loop the block OBJECTS
#   print "*"x 30,"Group from sequence $n_seq:","*"x 30,"\n$temp_group","*"x 70,"\n"; #for_debug
  } elsif ($n_seq =~ /(16)/) { #we are at the 16th sequence which shouldn't be reproduced
   $temp_group = $temp_group . $read_line; #reset the buffer for the sequence with the value of the line just found
   $found_end_node=0;
   while ($read_line = <SGF>) {
    ++$line;
    #print $read_line; #for_debug
    unless (defined ($read_line)) { die "Error (no new sequence found (line $line)";} #protective_code
#    if ($found_end_node) { print $read_line;} #for_debug (print the line after the end of the node)  
    if ($read_line =~ m%<\/node%) {
#     print "End of node line $line\n"; #print "---$read_line"; #for_debug
     $found_end_node  ? ($temp_file = $temp_file . $temp_group and goto END_OF_FILE) : ($found_end_node = 1);
     #we reached the end of the description of an object (</node>) so if we had a </node> before we do "last" (we reached the end of the layer)
     # otherwise we set $found_end_node to 1 so if next line is </node> it will do "last"
    }else { $found_end_node = 0; } #this line is not </node> so we reset the variable to 0
    if (($read_line =~ /<node.*name="(s(\d+)_\d+_[\w\-]+)"/) and ($2 > 16)) {$object_name = $1;$n_seq=$2; last;} #we found a sequence bigger than 16 so we stop
    $temp_group = $temp_group . $read_line; #copy the line in the buffer $temp_group
   } #end of while
#   print "*"x 62,"\n *We found object $object_name at line $line\n","*"x 62,"\n"; #for_debug
#   print LOG "*"x 30,"Sequence number $n_seq: ","*"x 30,"\n$temp_seq","*"x 70,"\n"; #for_debug
   #copy, modify and past the sequences#
  }else {die "Error: the sgf has a problem in line $line (wrong number of sequence): $read_line"; #protective_code
  } #end of if/else
 } #end of block OBJECTS
# print "*"x 30,"Group number 1","*"x 30,"\n$temp_group","*"x 70,"\n"; #for_debug
 # we now got the first group
 
 #copy, modify and past the blocks#
 $temp_file = $temp_file . $temp_group; #copy that group to the temporary buffer for the file
 $temp_file = $temp_file . &modif_block($temp_group,"y",1); #same with the second block-line
 $temp_file = $temp_file . &modif_block($temp_group,"y",2); #same with the third block-line
 #end of processin
 
 $found_end_node=0;
 while ($read_line = <SGF>) { #we will stop either either at the 49th sequence (if it exists) or the end of the synchronous layer (2 </node> in a row)
  ++$line;
#  if ($found_end_node) { print $read_line;} #for_debug (print the line after the end of the node)  
  if ($read_line =~ m%<\/node%) {
#   print "End of node line $line\n"; #print "---$read_line"; #for_debug
   $found_end_node  ? last : ($found_end_node = 1);
   #we reached the end of the description of an object (</node>) so if we had a </node> before we do "last" (we reached the end of the layer)
   # otherwise we set $found_end_node to 1 so if next line is </node> it will do "last"
  }else { $found_end_node = 0; } #this line is not </node> so we reset the variable to 0
  if (($read_line =~ /<node.*name="s(\d+)_\d+_[\w\-]+"/) and ($1 > 48)) {last;} #we found a sequence bigger than 48 so we stop
  unless (defined ($read_line)) { die "Error (no new sequence found (line $line)";} #protective_code
 } #end of while
# print "hello, we are now at line $line and the last \$read_line  is $read_line\n"; #for_debug
 $temp_file = $temp_file . $read_line; #copy the line with the last object read <node ...
 
 END_OF_FILE: while (<SGF>) {
   ++$line;
   $temp_file = $temp_file . $_; #copy the remaining content of the sgf file into the buffer
 } #end of while and block END_OF_FILE

open SGF_MODIF, ">$new_file" or die "Error while opening $new_file for modificiation ($!)\n";
print SGF_MODIF $temp_file;print "**Save modified sgf in $new_file\n"; #for_debug
#print SGF_MODIF $temp_group.&modif_block($temp_group,"y",1); print SGF_MODIF &modif_block($temp_group,"y",2);print "\nSave modification in $new_file\n"; ##for_debug##
print LOG "*"x 59,"\n"; #to print in the log file
} #end of block OPTIMISATION_OBJECTS

print "****** End of the reprocessing of TC for optimisation ******\n";

#-----------------------------------------------------------------------------------------------------------------------
{#-----------------------------------------------------subroutines-------------------------------------------------------

sub modif_block { # 3 arguments : 1=the block, 2="x" or "y", 3=the number to increment (1 or 2)
my ($temp_object,$xy,$incr)=@_; #reads the arguments
unless (defined $incr) {$incr=1;} #$incr is set by default to 1 if nothing is specified
if ($xy eq "x") {$incr2=$incr;$transl=8*$incr;} #value of the horizontal translation
  elsif ($xy eq "y") { $incr2=16 * $incr;$transl=-46.706*$incr;} #value of the vertical translation
  else {die "Error of type : please enter either x or y as 2 argument ($!)\n";}
 #if we do an operation on the block ($xy="y") the incrementation is 16 or 32 and it's 1 or 2 otherwise
 #the translation is, for each group, x=+8.333 for "x" and y=-47.323 for "y" 

$temp_object =~ s%\n%\n@%g; #put a "@" at the beginning of each new line
my @obj = split /@/, $temp_object; #transforms the text object into an array (each line being an element) using the @

my %out_fill=(); #hash table with the values of outline and filled boolean properties to be changed to
   #the keys look like "outline_x_06_1 where
   #   the first indicates if it is the filled_property or the outlineline_property (outline or filled)
   #   the second element indicates if the translation is made on x or y
   #   the third element is the number of the object
   #   the fourth element indicates how many blocks the translation is done
foreach $j ((1,3,5,7,9)) { #for the odd numbers
 foreach (1,2) {$out_fill{sprintf("outline_x_%02d_%1d",$j,$_)}="false";} # x is set to false for outline
 foreach (1,2) {$out_fill{sprintf("filled_x_%02d_%1d",$j,$_)}="true";} # x is set to true for filled
 foreach (1,2) {$out_fill{sprintf("outline_y_%02d_%1d",$j,$_)}="true";} # y is set to true for outline
 $out_fill{sprintf("filled_y_%02d_1",$j)}="false"; # y is set to false for filled and translation by 1
 $out_fill{sprintf("filled_y_%02d_2",$j)}="true"; # y is set to true for filled and translation by 2
}
foreach $j ((2,4,6,8)) { #for the odd numbers
 foreach (1,2) {$out_fill{sprintf("outline_y_%02d_%1d",$j,$_)}="false";} # y is set to false for outline
 foreach (1,2) {$out_fill{sprintf("filled_y_%02d_%1d",$j,$_)}="true";} # y is set to true for filled
 foreach (1,2) {$out_fill{sprintf("outline_x_%02d_%1d",$j,$_)}="true";} # x is set to true for outline
 $out_fill{sprintf("filled_x_%02d_1",$j)}="false"; # x is set to false for filled and translation by 1
 $out_fill{sprintf("filled_x_%02d_2",$j)}="true"; # x is set to true for filled and translation by 2
} #end of establishment of the hash table
#&print_hash(" key ", " value ", %out_fill); #for_debug

my $n_seq=0;#the number of the sequence currently read
my $n_obj=0; #the number of the object currently read
my $name_obj = ""; #the name of the object currently read

if ($obj[0] =~ /<node.*name="s(\d{2})_(\d{2})_([\w\-]+)"/) { $n_seq=$1; $n_obj=$2; $name_obj=$3;}
 else {die "Error in the subroutine ($xy | $incr): the first element should be a node\n",@obj,"<--end of object\n";}
 
for ($i = 0; $i < @obj; $i++) {
 if ($obj[$i] =~ s/s(\d{2})_(\d{2})/sprintf("s%02d_%02d", $1 + $incr2, $2)/e) {#change the number of the sequence to the new one
  $n_seq=$1;$n_obj=$2; #the number of the sequence and object
#  printf ("Seq%02d Obj%02d changed to Seq%02d Obj%02d\n", $n_seq, $n_obj, $n_seq + $incr2,$n_obj); #for_debug
 }elsif ($obj[$i] =~ s/( $xy)="([\d\-\.]*)"/sprintf("%s=\"%.3f\"",$1,$2+$transl)/e) {#translate the whole group by $transl in $xy
#  printf("Seq%02d Obj%02d: cartesian %s changed to %s\n", $2, $2+$transl); #for_debug
   }elsif ($obj[$i] =~ m%<(outline|filled)_property value="(false|true)"%) { #found the line with outline or filled properties
  my $new_value= $out_fill{sprintf("%s_%s_%02d_%1d",$1,$xy,$n_obj,$incr)};
  unless (($n_obj < 1) or (($xy eq "y")and($n_obj =~ /[2468]/))) { #doesn't apply for even numbers for "y"
#   printf "Seq%02d Obj%02d: %7s changed from %5s to %5s\n",$n_seq,$n_obj,$1,$2,$new_value; #for_debug
   $obj[$i] =~ s#$2#$new_value#
  } #except for Backgroundrectangle and even numbers in y;
 } else {}
} #end of FOR
join "",@obj; #returns the result
} #end of sub modif_block

sub print_hash { #print Hash Table
my ($tab1,$tab2,%hash)=@_;
my @keys=sort keys %hash;
print "\n","-" x 150,"\n\n";
printf("%-42s %5s\n", $tab1, $tab2);
printf("%-42s  %5s\n", "-"x6, "-------");
foreach (@keys) {
   printf("%-30s %-s\n", $_, $hash{$_});
} #end of foreach
print "\n","-" x 150, "\n";
} #end of subroutines to print hash tables

}#end of subroutines
#---------------------------------------------------------------------------------------------------------------------------------

【上篇】
【下篇】

抱歉!评论已关闭.