Mercurial > repos > fgiacomoni > hr2

comparison lib/hr.pm @ 0:86296c048e46 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Init repository for [hr2]
author fgiacomoni
date Wed, 05 Jun 2019 09:40:20 -0400
parents
children e2cbcf6fa22e
comparison
equal deleted inserted replaced
-1:000000000000 0:86296c048e46
1 package lib::hr ;
2
3 use strict;
4 no strict "refs" ;
5 use warnings ;
6 use Exporter ;
7 use threads ;
8 use HTML::Template ;
9 use Carp ;
10
11 use Data::Dumper ;
12
13 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS);
14
15 our $VERSION = "1.0";
16 our @ISA = qw(Exporter);
17 our @EXPORT = qw( manage_atoms_and_ranges manage_atoms check_hr_exe manage_atom_and_range manage_tolerance manage_mode config_hr_exe );
18 our %EXPORT_TAGS = ( ALL => [qw(manage_atoms_and_ranges manage_atoms check_hr_exe manage_atom_and_range manage_tolerance manage_mode config_hr_exe )] );
19
20 =head1 NAME
21
22 lib::hr - A module for managing / launching hr binary (structure elucidation c++ progr)
23
24 =head1 SYNOPSIS
25
26 use lib::hr;
27 my $object = lib::hr->new();
28 print $object->as_string;
29
30 =head1 DESCRIPTION
31
32 This module does not really exist, it
33 was made for the sole purpose of
34 demonstrating how POD works.
35
36 =head1 METHODS
37
38 Methods are :
39
40 =head2 METHOD new
41
42 ## Description : new
43 ## Input : $self
44 ## Ouput : bless $self ;
45 ## Usage : new() ;
46
47 =cut
48
49 sub new {
50 ## Variables
51 my $self={};
52 bless($self) ;
53 return $self ;
54 }
55 ### END of SUB
56
57 =head2 METHOD manage_atoms_and_ranges
58
59 ## Description : allow from an initial config to add or delete atoms and their range
60 ## Input : $atomsconfig, $atombasic, $atomsupp
61 ## Output : $atomcleanconfig
62 ## Usage : my ( $atomcleanconfig ) = manage_atoms_and_ranges ( $atomsconfig, $atombasic, $atomsupp ) ;
63
64 =cut
65 ## START of SUB
66 sub manage_atoms_and_ranges {
67 ## Retrieve Values
68 my $self = shift ;
69 my ( $atomsconfig, $CONF, $atombasic, $atomsupp ) = @_;
70 my ( $atomcleanconfig ) = ( undef ) ;
71
72 # basic atoms case:
73 foreach my $atom ( (split(",", $atombasic )) ) {
74 if ( exists $CONF->{$atom} ) { $atomsconfig->{$atom}{'max'} = $CONF->{$atom} ; }
75 }
76
77 # suppl. atoms case
78 foreach my $atom ( (split(",", $atomsupp )) ) {
79 print "*** $atom***\n" ;
80 if ( exists $atomsconfig->{$atom} ) { $atomsconfig->{$atom} = $CONF->{'DEFAULT_MAX'} ; }
81 }
82
83 # Create atoms and range parameters:
84 foreach my $selectedAtom ( keys %{$atomsconfig} ) {
85 $atomcleanconfig .= ' -'.$selectedAtom.' '.$atomsconfig->{$selectedAtom}{'min'}.'-'.$atomsconfig->{$selectedAtom}{'max'} ;
86 }
87
88 return ($atomcleanconfig) ;
89 }
90 ### END of SUB
91
92
93
94 =head2 METHOD manage_atoms ### DEPRECATED
95
96 ## Description : controles atoms input list and prepare it like hr binary parameter
97 ## Input : $input_atoms, $conf_atoms
98 ## Output : $hr_atoms_param
99 ## Usage : my ( $hr_atoms_param ) = manage_atoms( $input_atoms, $conf_atoms ) ;
100 ### DEPRECATED
101
102 =cut
103 ## START of SUB
104 sub manage_atoms { ### DEPRECATED
105 ## Retrieve Values
106 my $self = shift ;
107 my ( $input_atoms, $conf_atoms ) = @_ ;
108 my $hr_atoms_param = undef ;
109
110 if ( ( defined $$input_atoms ) and ( defined $$conf_atoms ) ) {
111 if ( ( $$input_atoms eq 'None' ) or ( $$input_atoms eq '' ) or ( $$input_atoms eq ' ' ) ) { $hr_atoms_param = $$conf_atoms ; }
112 elsif ( $$input_atoms =~ /[P|S|F|L|K|B|A|1|,]+/ ) { $hr_atoms_param = $$conf_atoms.','.$$input_atoms ; }
113 else { $hr_atoms_param = $$conf_atoms ; }
114 } ## END IF
115 elsif ( !defined $$input_atoms ) { $hr_atoms_param = $$conf_atoms ; }
116 elsif ( !defined $$conf_atoms ) { warn "hr module can't manage any atom list (undef values in conf)\n" ; }
117 else { warn "hr module musn't manage any atom list\n" ; }
118
119 return(\$hr_atoms_param) ;
120 }
121 ## END of SUB
122
123 =head2 METHOD manage_atom_and_range ### DEPRECATED
124
125 ## Description : build atom range with defined value in conf file
126 ## Input : $atom, $min, $max
127 ## Output : $hr_range
128 ## Usage : my ( ) = manage_atom_and_range( $atom, $min, $max ) ;
129 ### DEPRECATED
130
131 =cut
132 ## START of SUB
133 sub manage_atom_and_range { ### DEPRECATED
134 ## Retrieve Values
135 my $self = shift ;
136 my ( $atom, $min, $max ) = @_ ;
137 my $hr_range = undef ;
138
139 if ( ( defined $$atom ) and ( defined $$min ) and ( defined $$max ) ) {
140 ## manage ragne like "-C 0-200"
141 $hr_range = ' -'.$$atom.' '.$$min.'-'.$$max ;
142 } ## END IF
143 else {
144 warn "Some argvts are missing to build the current atom range line\n" ;
145 }
146 return(\$hr_range) ;
147 }
148 ## END of SUB
149
150 =head2 METHOD manage_tolerance
151
152 ## Description : check range and format of tolerance
153 ## Input : $tolerance, $default_value
154 ## Output : $set_tol
155 ## Usage : my ( $set_tol ) = manage_tolerance( $tolerance, $default_value ) ;
156
157 =cut
158 ## START of SUB
159 sub manage_tolerance {
160 ## Retrieve Values
161 my $self = shift ;
162 my ( $tolerance, $default_value ) = @_ ;
163 my ($set_tol, $tmp_tol ) = (undef, undef) ;
164
165 if ( ( defined $$tolerance ) and ( defined $$default_value )) {
166 $tmp_tol = $$tolerance ;
167 $tmp_tol =~ tr/,/./;
168 ## tolerance doit etre >0 et <10
169 if ( $tmp_tol <= 0 || $tmp_tol >= 10 ){
170 $set_tol = $$default_value ;
171 warn "The used tolerance is set to $$default_value (out of authorized range)\n" ;
172 }
173 else{ $set_tol = $tmp_tol ; }
174 }
175 else { warn "Your tolerance or the default tol are not defined\n" ; }
176
177 return(\$set_tol) ;
178 }
179 ## END of SUB
180
181 =head2 METHOD manage_mode
182
183 ## Description : manage mode and apply mass correction (positive/negative/neutral)
184 ## Input : $mode, $charge, $electron, $proton, $mass
185 ## Output : $exact_mass
186 ## Usage : my ( $exact_mass ) = manage_mode( $mode, $charge, $electron, $proton, $mass ) ;
187
188 =cut
189 ## START of SUB
190 sub manage_mode {
191 ## Retrieve Values
192 my $self = shift ;
193 my ( $mode, $charge, $electron, $proton, $mass ) = @_ ;
194 my ($exact_mass, $tmp_mass) = ( undef, undef ) ;
195
196 ## some explanations :
197 # MS in + mode = adds H+ (proton) and molecule is positive : el+ => $charge = "positive"
198 # For HR, need to subtrack proton mz and to add electron mz (1 electron per charge) to the input mass which comes neutral!
199
200 if ( ( defined $$electron ) and ( defined $$proton ) ) {
201 # check mass
202 if ( defined $$mass ) { $tmp_mass = $$mass ; $tmp_mass =~ tr/,/./ ; } # manage . and , in case of...
203 else { warn "No mass is defined\n" }
204
205 # manage charge
206 if ( ( !defined $$charge ) || ($$charge < 0) ){ warn "Charge is not defined or value is less than zero\n" ; }
207
208 # set neutral mass in function of ms mode
209 if($$mode eq 'positive') { $exact_mass = ( $tmp_mass - $$proton + $$electron) * $$charge ; }
210 elsif($$mode eq 'negative') { $exact_mass = ( $tmp_mass + $$proton - $$electron) * $$charge ; }
211 elsif($$mode eq "neutral") { $exact_mass = $tmp_mass ; }
212 else { warn "This mode doesn't exist : please select positive/negative or neutral mode\n" ; }
213 }
214 else {
215 warn "Missing some parameter values (electron, neutron masses), please check your conf file\n" ;
216 }
217 return(\$exact_mass) ;
218 }
219 ## END of SUB
220
221 =head2 METHOD check_hr_exe
222
223 ## Description : permit to check the path of hr.exe and its full availability
224 ## Input : $hr_path, $hr_version
225 ## Output : true/false
226 ## Usage : my ( $res ) = check_hr_exe( $hr_path, $hr_version ) ;
227
228 =cut
229 ## START of SUB
230 sub check_hr_exe {
231 ## Retrieve Values
232 my $self = shift ;
233 my ( $hr_path, $hr_version ) = @_ ;
234 my $success = undef ;
235 my $check_res = undef ;
236
237 ## test path :
238 if ( ( defined $$hr_path ) and ( defined $$hr_version ) ) {
239 if ( defined $$hr_path ) {
240 $success = `$$hr_path -version`;
241 print "$success\n" ;
242 if ($success !~/^$$hr_version/) { warn "You do not use the expected version of hr2 ($$hr_version)\n" ; }
243 else { $check_res = 1 ; }
244 }
245 else { warn "Can't use HR because the binary file doesn't exist at the specified path ($$hr_path)\n" ; }
246
247 } ## END IF
248 else { warn "No HR path or Hr version defined\n" ; }
249
250 return($check_res) ;
251 }
252 ## END of SUB
253
254 =head2 METHOD config_hr_exe
255
256 ## Description : builds hr execute line with needed params
257 ## Input : $hr_path, $hr_delta, $mass, $has_goldenrules, $atoms_and_ranks
258 ## Output : var2
259 ## Usage : my ( var2 ) = config_hr_exe( $hr_path, $hr_delta, $mass, $has_goldenrules, $atoms_and_ranks ) ;
260
261 =cut
262 ## START of SUB
263 sub config_hr_exe {
264 ## Retrieve Values
265 my $self = shift ;
266 my ( $hr_path, $hr_delta, $mass, $has_goldenrules, $atoms_and_ranks ) = @_ ;
267 my $hr_cmd = undef ;
268
269 if ( ( defined $$hr_path ) and ( defined $$hr_delta ) and ( defined $$mass ) and ( defined $$atoms_and_ranks ) ) {
270 $hr_cmd = $$hr_path.' -t '.$$hr_delta.' -m '.$$mass.' '.$$atoms_and_ranks ;
271 if ( defined $$has_goldenrules ) { $$hr_cmd .= ' -g ' ; }
272 } ## END IF
273 else { warn "Some argvts are missing to build the current hr exec line\n" ; }
274
275 return(\$hr_cmd) ;
276 }
277 ## END of SUB
278
279 =head2 METHOD threading_hr_exe
280
281 ## Description : prepare 5 threads for hr executing
282 ## Input : $method, $list
283 ## Output : $results
284 ## Usage : my ( $results ) = threading_hr_exe( $method, $list ) ;
285
286 =cut
287 ## START of SUB
288 sub threading_hr_exe {
289 ## Retrieve Values
290 my $self = shift ;
291 my ( $method, $list ) = @_ ;
292
293 my @results = () ;
294
295 if ( ( defined $list ) and ( defined $method )) {
296
297 for (my $i = 0; $i < (scalar @{$list}); $i+=6 ) {
298 my $thr1 = threads->create($method, $self, $list->[$i]) if $list->[$i] ;
299 my $thr2 = threads->create($method, $self, $list->[$i+1]) if $list->[$i+1] ;
300 my $thr3 = threads->create($method, $self, $list->[$i+2]) if $list->[$i+2] ;
301 my $thr4 = threads->create($method, $self, $list->[$i+3]) if $list->[$i+3] ;
302 my $thr5 = threads->create($method, $self, $list->[$i+4]) if $list->[$i+4] ;
303 my $thr6 = threads->create($method, $self, $list->[$i+5]) if $list->[$i+5] ;
304 push ( @results, $thr1->join ) if $list->[$i] ;
305 push ( @results, $thr2->join ) if $list->[$i+1] ;
306 push ( @results, $thr3->join ) if $list->[$i+2] ;
307 push ( @results, $thr4->join ) if $list->[$i+3] ;
308 push ( @results, $thr5->join ) if $list->[$i+4] ;
309 push ( @results, $thr6->join ) if $list->[$i+5] ;
310 }
311 }
312 else {
313 warn "Your input list or your method is undefined\n" ;
314 }
315
316 return(\@results) ;
317 }
318 ## END of SUB
319
320 =head2 METHOD hr_exe
321
322 ## Description : hr_exe launches hr and catches result
323 ## Input : $cmd
324 ## Output : $res
325 ## Usage : my ( $res ) = hr_exe( $cmd ) ;
326
327 =cut
328 ## START of SUB
329 sub hr_exe {
330 ## Retrieve Values
331 my $self = shift ;
332 my ( $cmd ) = @_ ;
333 my $res = undef ;
334
335 if (defined $cmd){
336 #print "\n--CMD used : $cmd\n" ;
337 $res = `$cmd` ;
338 sleep(0.5) ;
339 #print "Results : $res\n" ;
340 }
341
342 return (\$res) ;
343 }
344 ## END of SUB
345
346
347 =head2 METHOD hr_out_parser
348
349 ## Description : parse output of hr and return a hash of features
350 ## Input : $res
351 ## Output : $parsed_res
352 ## Usage : my ( $parsed_res ) = hr_out_parser( $res ) ;
353
354 =cut
355 ## START of SUB
356 sub hr_out_parser {
357 ## Retrieve Values
358 my $self = shift ;
359 my ( $res ) = @_ ;
360
361 my %parsed_res = () ;
362 my ( @formula, @rings_and_double_bond_equivalents, @formula_mz, @mmus ) = ( (), (), (), () ) ;
363 my ( $formula_nb, $formula_total, $time ) = ( undef, undef, undef ) ;
364
365 if ( defined $$res ) {
366 # foreach line
367 foreach my $line (split(/\n/,$$res)){
368 ## v1.02 - parse result line "C7.H17.N5. 2.0 171.1484 +17.2 mmu"
369 ## v1.03 - parse result line "C10.H25.N5.O5.P2.S2. C10H25N5O5P2S2 8.00 421.0772333 0 0 +0.40"
370 ## $1 = "C10.H25.N5.O5.P2.S2. " $2 = "C10H25N5O5P2S2" $3 = "8.00" $4="421.0772333" $5="0" $6="0" $7="+0.40"
371 ## if ( $line =~ /([\w|\.]+)\s+(\d+.?\d*)\s+(\d+.?\d*)\s+([+|-]\d+.?\d*)\s+(.*)/ ) { ## for hr2 1.02
372
373 if ( $line =~ /([\w|\.]+)\s+(\w+)\s+(\d+.?\d*)\s+(\d+.?\d*)\s+(\d+.?\d*)\s+(\d+.?\d*)\s+([+|-]\d+.?\d*)/ ) { # for hr2 1.03
374 my ( $formula, $cleanformula, $rings_and_double_bond_equivalent, $formula_mz, $abscharge, $nadd, $mmu_value ) = ( $1, $2, $3, $4, $5, $6, $7 ) ;
375
376 if (defined $formula ) { $formula =~ s/\.//g ; push (@formula, $formula) ; } # clean \.
377 if (defined $rings_and_double_bond_equivalent ) { push (@rings_and_double_bond_equivalents, $rings_and_double_bond_equivalent) ; } #
378 if (defined $formula_mz ) { push (@formula_mz, $formula_mz) ; }
379 if (defined $mmu_value ) { $mmu_value =~ s/\+// ; push (@mmus, $mmu_value) ; } # clean (+)
380 }
381 elsif ( $line =~ /(\d+)\s+formulas.+\s+(\d+)\s+seconds.+\s+(\d+)\s+formulae/ ) {
382 ( $formula_nb, $time, $formula_total ) = ( $1, $2, $3 ) ;
383 }
384 else { next; }
385 }
386 # build parser
387 if ( scalar(@formula) > 0 ){
388 $parsed_res{'ENTRY_FORMULA'} = \@formula ;
389 $parsed_res{'rings_and_double_bond_equivalents'} = \@rings_and_double_bond_equivalents ;
390 $parsed_res{'ENTRY_CPD_MZ'} = \@formula_mz ;
391 $parsed_res{'ENTRY_DELTA'} = \@mmus ;
392 $parsed_res{'MASSES_TOTAL'} = \$formula_nb ;
393 $parsed_res{'time'} = \$time ;
394 }
395 }
396 return(\%parsed_res) ;
397 }
398 ## END of SUB
399
400
401 =head2 METHOD set_html_tbody_object
402
403 ## Description : initializes and build the tbody object (perl array) need to html template
404 ## Input : $nb_pages, $nb_items_per_page
405 ## Output : $tbody_object
406 ## Usage : my ( $tbody_object ) = set_html_tbody_object($nb_pages, $nb_items_per_page) ;
407
408 =cut
409 ## START of SUB
410 sub set_html_tbody_object {
411 my $self = shift ;
412 my ( $nb_pages, $nb_items_per_page ) = @_ ;
413
414 my ( @tbody_object ) = ( ) ;
415
416 for ( my $i = 1 ; $i <= $nb_pages ; $i++ ) {
417
418 my %pages = (
419 # tbody feature
420 PAGE_NB => $i,
421 MASSES => [], ## end MASSES
422 ) ; ## end TBODY N
423 push (@tbody_object, \%pages) ;
424 }
425 return(\@tbody_object) ;
426 }
427 ## END of SUB
428
429 =head2 METHOD add_mz_to_tbody_object
430
431 ## Description : initializes and build the mz object (perl array) need to html template
432 ## Input : $tbody_object, $nb_items_per_page, $mz_list
433 ## Output : $tbody_object
434 ## Usage : my ( $tbody_object ) = add_mz_to_tbody_object( $tbody_object, $nb_items_per_page, $mz_list ) ;
435
436 =cut
437 ## START of SUB
438 sub add_mz_to_tbody_object {
439 my $self = shift ;
440 my ( $tbody_object, $nb_items_per_page, $mz_list, $ids_list, $totals ) = @_ ;
441
442 my ( $current_page, $mz_index ) = ( 0, 0 ) ;
443
444 foreach my $page ( @{$tbody_object} ) {
445
446 my @colors = ('white', 'green') ;
447 my ( $current_index, , $icolor ) = ( 0, 0 ) ;
448
449 for ( my $i = 1 ; $i <= $nb_items_per_page ; $i++ ) {
450 #
451 if ( $current_index > $nb_items_per_page ) { ## manage exact mz per html page
452 $current_index = 0 ;
453 last ; ##
454 }
455 else {
456 $current_index++ ;
457 if ( $icolor > 1 ) { $icolor = 0 ; }
458
459 if ( exists $mz_list->[$mz_index] ) {
460 my $total = \0 ;
461 if ( $totals->[$mz_index]{'MASSES_TOTAL'} ) { $total = $totals->[$mz_index]{'MASSES_TOTAL'} }
462
463 my %mz = (
464 # mass feature
465 MASSES_ID_QUERY => $ids_list->[$mz_index],
466 MASSES_MZ_QUERY => $mz_list->[$mz_index],
467 MZ_COLOR => $colors[$icolor],
468 MASSES_NB => $mz_index+1,
469 MASSES_TOTAL => $$total ,
470 ENTRIES => [] ,
471 ) ;
472 push ( @{ $tbody_object->[$current_page]{MASSES} }, \%mz ) ;
473 # Html attr for mass
474 $icolor++ ;
475 }
476 }
477 $mz_index++ ;
478 } ## foreach mz
479
480 $current_page++ ;
481 }
482 return($tbody_object) ;
483 }
484 ## END of SUB
485
486 =head2 METHOD add_entries_to_tbody_object
487
488 ## Description : initializes and build the mz object (perl array) need to html template
489 ## Input : $tbody_object, $nb_items_per_page, $mz_list, $entries
490 ## Output : $tbody_object
491 ## Usage : my ( $tbody_object ) = add_entries_to_tbody_object( $tbody_object, $nb_items_per_page, $mz_list, $entries ) ;
492
493 =cut
494 ## START of SUB
495 sub add_entries_to_tbody_object {
496 ## Retrieve Values
497 my $self = shift ;
498 my ( $tbody_object, $results ) = @_ ;
499
500 my $index_page = 0 ;
501 my $index_mz_continous = 0 ;
502
503 foreach my $page (@{$tbody_object}) {
504
505 my $index_mz = 0 ;
506
507 foreach my $mz (@{ $tbody_object->[$index_page]{MASSES} }) {
508
509 my $index_res = 0 ;
510 if ( $results->[$index_mz_continous]{ENTRY_FORMULA} ){
511
512 my $entry_nb = scalar( @{ $results->[$index_mz_continous]{ENTRY_FORMULA} } ) ;
513 for( my $i = 0 ; $i<$entry_nb; $i++ ) {
514 my %entry = (
515 ENTRY_COLOR => $tbody_object->[$index_page]{MASSES}[$index_mz]{MZ_COLOR},
516 ENTRY_FORMULA => $results->[$index_mz_continous]->{ENTRY_FORMULA}[$i],
517 ENTRY_CPD_MZ => $results->[$index_mz_continous]->{ENTRY_CPD_MZ}[$i],
518 ENTRY_DELTA => $results->[$index_mz_continous]->{ENTRY_DELTA}[$i]
519 ) ;
520 push ( @{ $tbody_object->[$index_page]{MASSES}[$index_mz]{ENTRIES} }, \%entry) ;
521 }
522 $index_res++ ;
523 }
524 $index_mz ++ ;
525 $index_mz_continous ++ ;
526 }
527 $index_page++ ;
528 }
529 return($tbody_object) ;
530 }
531 ## END of SUB
532
533 =head2 METHOD write_html_skel
534
535 ## Description : prepare and write the html output file
536 ## Input : $html_file_name, $html_object, $html_template
537 ## Output : $html_file_name
538 ## Usage : my ( $html_file_name ) = write_html_skel( $html_file_name, $html_object ) ;
539
540 =cut
541 ## START of SUB
542 sub write_html_skel {
543 ## Retrieve Values
544 my $self = shift ;
545 my ( $html_file_name, $html_object, $pages , $search_condition, $html_template, $js_path, $css_path ) = @_ ;
546
547 my $html_file = $$html_file_name ;
548
549 if ( defined $html_file ) {
550 open ( HTML, ">$html_file" ) or die "Can't create the output file $html_file " ;
551
552 if (-e $html_template) {
553 my $ohtml = HTML::Template->new(filename => $html_template);
554 $ohtml->param( JS_GALAXY_PATH => $js_path, CSS_GALAXY_PATH => $css_path ) ;
555 $ohtml->param( CONDITIONS => $search_condition ) ;
556 $ohtml->param( PAGES_NB => $pages ) ;
557 $ohtml->param( PAGES => $html_object ) ;
558 print HTML $ohtml->output ;
559 }
560 else {
561 croak "Can't fill any html output : No template available ($html_template)\n" ;
562 }
563
564 close (HTML) ;
565 }
566 else {
567 croak "No output file name available to write HTML file\n" ;
568 }
569 return(\$html_file) ;
570 }
571 ## END of SUB
572
573 =head2 METHOD write_csv_one_mass
574
575 ## Description : print a csv file
576 ## Input : $masses, $ids, $results, $file
577 ## Output : N/A
578 ## Usage : write_csv_one_mass( $ids, $results, $file ) ;
579
580 =cut
581 ## START of SUB
582 sub write_csv_one_mass {
583 ## Retrieve Values
584 my $self = shift ;
585 my ( $masses, $ids, $results, $file, ) = @_ ;
586
587 open(CSV, '>:utf8', "$file") or die "Cant' create the file $file\n" ;
588 print CSV "ID\tMASS_SUBMIT\tCPD_FORMULA\tCPD_MW\tDELTA\n" ;
589
590 my $i = 0 ;
591
592 foreach my $id (@{$ids}) {
593 my $mass = $masses->[$i] ;
594
595 if ( $results->[$i] ) { ## an requested id has a result in the list of hashes $results.
596
597 my $entry_nb = 0 ;
598
599 ## in case of no results -- Hr_parsed Results : $VAR1 = [ { 'ENTRY_FORMULA' => [] } ];
600 if ( !$results->[$i]{'ENTRY_FORMULA'} ) { print CSV "$id\t$mass\tN/A\t0.0\t0.0\n" ; }
601
602 foreach (@{$results->[$i]{'ENTRY_FORMULA'}}) {
603
604 print CSV "$id\t$mass\t" ;
605 ## print cpd formula
606 if ( $results->[$i]{'ENTRY_FORMULA'}[$entry_nb] ) { print CSV "$results->[$i]{'ENTRY_FORMULA'}[$entry_nb]\t" ; }
607 else { print CSV "N/A\t" ; }
608 ## print cpd name
609 if ( $results->[$i]{'ENTRY_CPD_MZ'}[$entry_nb] ) { print CSV "$results->[$i]{'ENTRY_CPD_MZ'}[$entry_nb]\t" ; }
610 else { print CSV "0.0\t" ; }
611 ## print delta
612 if ( $results->[$i]{'ENTRY_DELTA'}[$entry_nb] ) { print CSV "$results->[$i]{'ENTRY_DELTA'}[$entry_nb]\n" ; }
613 else { print CSV "0.0\n" ; }
614 $entry_nb++ ;
615 }
616 }
617 else {
618 print CSV "$id\t$mass\tN/A\t0.0\t0.0\n" ;
619 }
620 $i++ ;
621 }
622 close(CSV) ;
623 return() ;
624 }
625 ## END of SUB
626
627 =head2 METHOD add_hr_matrix_to_input_matrix
628
629 ## Description : build a full matrix (input + lm column)
630 ## Input : $input_matrix_object, $lm_matrix_object
631 ## Output : $output_matrix_object
632 ## Usage : my ( $output_matrix_object ) = add_hr_matrix_to_input_matrix( $input_matrix_object, $hr_matrix_object ) ;
633
634 =cut
635 ## START of SUB
636 sub add_hr_matrix_to_input_matrix {
637 ## Retrieve Values
638 my $self = shift ;
639 my ( $input_matrix_object, $hr_matrix_object ) = @_ ;
640
641 my @output_matrix_object = () ;
642 my $index_row = 0 ;
643
644 foreach my $row ( @{$input_matrix_object} ) {
645 my @init_row = @{$row} ;
646
647 if ( $hr_matrix_object->[$index_row] ) {
648 my $dim = scalar(@{$hr_matrix_object->[$index_row]}) ;
649
650 if ($dim > 1) { warn "the add method can't manage more than one column\n" ;}
651 my $lm_col = $hr_matrix_object->[$index_row][$dim-1] ;
652
653 push (@init_row, $lm_col) ;
654 $index_row++ ;
655 }
656 push (@output_matrix_object, \@init_row) ;
657 }
658 return(\@output_matrix_object) ;
659 }
660 ## END of SUB
661
662 =head2 METHOD write_csv_skel
663
664 ## Description : prepare and write csv output file
665 ## Input : $csv_file, $rows
666 ## Output : $csv_file
667 ## Usage : my ( $csv_file ) = write_csv_skel( $csv_file, $rows ) ;
668
669 =cut
670 ## START of SUB
671 sub write_csv_skel {
672 ## Retrieve Values
673 my $self = shift ;
674 my ( $csv_file, $rows ) = @_ ;
675
676 my $ocsv = lib::csv::new() ;
677 my $csv = $ocsv->get_csv_object("\t") ;
678 $ocsv->write_csv_from_arrays($csv, $$csv_file, $rows) ;
679
680 return($csv_file) ;
681 }
682 ## END of SUB
683
684 =head2 METHOD set_hr_matrix_object
685
686 ## Description : build the hr_row under its ref form
687 ## Input : $header, $init_mzs, $entries
688 ## Output : $hr_matrix
689 ## Usage : my ( $hmdb_matrix ) = set_hr_matrix_object( $header, $init_mzs, $entries ) ;
690
691 =cut
692 ## START of SUB
693 sub set_hr_matrix_object {
694 ## Retrieve Values
695 my $self = shift ;
696 my ( $header, $init_mzs, $entries ) = @_ ;
697
698 my @hr_matrix = () ;
699
700 if ( defined $header ) {
701 my @headers = () ;
702 push @headers, $header ;
703 push @hr_matrix, \@headers ;
704 }
705
706 my $index_mz = 0 ;
707
708 foreach my $mz ( @{$init_mzs} ) {
709
710 my $index_entries = 0 ;
711 my @clusters = () ;
712 my $cluster_col = undef ;
713
714 my $nb_entries = $entries->[$index_mz]{MASSES_TOTAL} ;
715
716 foreach (@{$entries->[$index_mz]{'ENTRY_FORMULA'}}) {
717
718 my $delta = $entries->[$index_mz]{'ENTRY_DELTA'}[$index_entries] ;
719 my $hr_formula = $entries->[$index_mz]{'ENTRY_FORMULA'}[$index_entries] ;
720 my $hr_mz = $entries->[$index_mz]{'ENTRY_CPD_MZ'}[$index_entries] ;
721
722
723 ## METLIN data display model
724 ## entry1=VAR1::VAR2::VAR3::VAR4|entry2=VAR1::VAR2::VAR3::VAR4|...
725 # manage final pipe
726 if ($index_entries < $$nb_entries-1 ) { $cluster_col .= $delta.'::('.$hr_formula.')::'.$hr_mz.'|' ; }
727 else { $cluster_col .= $delta.'::('.$hr_formula.')::'.$hr_mz ; }
728
729 $index_entries++ ;
730 } ## end foreach
731 if ( !defined $cluster_col ) { $cluster_col = 'No_result_found_with HR' ; }
732 push (@clusters, $cluster_col) ;
733 push (@hr_matrix, \@clusters) ;
734 $index_mz++ ;
735 }
736 return(\@hr_matrix) ;
737 }
738 ## END of SUB
739
740
741
742 1 ;
743
744
745 __END__
746
747 =head1 SUPPORT
748
749 You can find documentation for this module with the perldoc command.
750
751 perldoc hr.pm
752
753 =head1 Exports
754
755 =over 4
756
757 =item :ALL is manage_atoms, check_hr_exe, manage_tolerance
758
759 =back
760
761 =head1 AUTHOR
762
763 Franck Giacomoni E<lt>franck.giacomoni@clermont.inra.frE<gt>
764
765 =head1 LICENSE
766
767 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
768
769 =head1 VERSION
770
771 version 1 : 02 / 20 / 2014
772
773 version 2 : ??
774
775 =cut