Re: Little pattern problem...

I think this does what you describe.

#! perl -slw
use strict;

my( $target_name, %probes );

$_ = <DATA>; # Prime the pump.

do {
      # extract the target name
    $target_name = $1 if m[( \d{7} ) _at: \d{3} : \d{3} ]x;

    while( m[$target_name] ) { 
     # process the record containing the current target name
        my $probe = <DATA>; # Read the probe
        chomp $probe;

            # save it in an HoA keyed by the target name
        push @{ $probes{ $target_name } }, $probe;

        last unless defined( $_ = <DATA> ); # get the next line;
    }
} until eof DATA; # till done

print $_, ' : ', join', ', @{ $probes{ $_ } } for keys %probes;

__DATA__
probe:MOE430A:1415670_at:549:177; Interrogation_Position=2513; Antisen
+se;
GAGGAAACGTTCACCCTGTCTACTA
probe:MOE430A:1415670_at:467:433; Interrogation_Position=2521; Antisen
+se;
GTTCACCCTGTCTACTATCAAGACA
probe:MOE430A:1415670_at:254:643; Interrogation_Position=2533; Antisen
+se;
TACTATCAAGACACTCGAAGAGGCT
probe:MOE430A:1415670_at:54:269; Interrogation_Position=2556; Antisens
+e;
CTGTGGGCAATATTGTGAAGTTCCT
probe:MOE430A:1415670_at:405:339; Interrogation_Position=2583; Antisen
+se;
GAATGCATCCTTGTGAGAGGTCAGA
probe:MOE430A:1415670_at:60:395; Interrogation_Position=2597; Antisens
+e;
GAGAGGTCAGACAAAGTGCCAGAAA
probe:MOE430A:1415670_at:284:165; Interrogation_Position=2619; Antisen
+se;
AAAACAAGAACACCCACACGCTGCT
probe:MOE430A:1415670_at:622:145; Interrogation_Position=2634; Antisen
+se;
ACACGCTGCTGCTAGCTGGAGTATT
probe:MOE430A:1415670_at:291:661; Interrogation_Position=2804; Antisen
+se;
TATCTTGTCCAACACTACGTCGAAG
probe:MOE430A:1415670_at:146:701; Interrogation_Position=2956; Antisen
+se;
TTGTCACCATGCCTGCAAGGAGAGA
probe:MOE430A:1415671_at:116:525; Interrogation_Position=1156; Antisen
+se;
GGAACAGGAATGTCGCAACATCGTA
probe:MOE430A:1415671_at:655:137; Interrogation_Position=1173; Antisen
+se;
ACATCGTATGGATTGCTGAGTGCAT
probe:MOE430A:1415671_at:398:139; Interrogation_Position=1232; Antisen
+se;
GGCTGATCACATCCAAAAAGTCATG
[download]

Output

P:\test>285872
1415671 : GGAACAGGAATGTCGCAACATCGTA, ACATCGTATGGATTGCTGAGTGCAT, GGCTGA
+TCACATCCAAAAAGTCATG
1415670 : GAGGAAACGTTCACCCTGTCTACTA, GTTCACCCTGTCTACTATCAAGACA, TACTAT
+CAAGACACTCGAAGAGGCT, CTGTGGGCAATATTGTGAAGTTCCT, GAATGCATCCTTGTGAGAGGT
+CAGA, GAGAGGTCAGACAAAGTGCCAGAAA, AAAACAAGAACACCCACACGCTGCT, ACACGCTGC
+TGCTAGCTGGAGTATT, TATCTTGTCCAACACTACGTCGAAG, TTGTCACCATGCCTGCAAGGAGAG
+A
[download]

Examine what is said, not who speaks.

"Efficiency is intelligent laziness." -David Dunham
"When I'm working on a problem, I never think about beauty. I think only how to solve the problem. But when I have finished, if the solution is not beautiful, I know it is wrong." -Richard Buckminster Fuller
If I understand your problem, I can solve it! Of course, the same can be said for you.

Comment on Re: Little pattern problem... Select or Download Code

Replies are listed 'Best First'.

Re: Re: Little pattern problem...
by BrowserUk (Patriarch) on Sep 05, 2003 at 19:50 UTC

In response to a /msg.

  $target_name = $1 if m[( \d{7} ) _at: \d{3} : \d{3} ]x;
[download]

If the regex matches $_ (ie. the line read in from the DATA file), then the 7-digit number '\d{7}' is captured (because of the brackets) into the perl special variable $1. Because the regex matched, the if condition is true and so the value of $1 will be assigned to the variable $target_name.

If that isn't clear then I suggest your find and read the documents perlrequick and perlretut, particularly the sections entitled "Extracting matches" in both. You should have copies of these on your system, but the above links will take you to the latest versions incase you haven't. They won't take long to read and they do a much better job of explaining this stuff than I would.

I hope that clarifies things a little.

Examine what is said, not who speaks.

[reply]
[d/l]


No such thing as a small change
	PerlMonks