WebHU - Programozási kérdések és válaszok

Csoportosítja a mintát pozíciók szerint?

A következő bemeneti fájlom van.

ggaaaa (973026 to 973032)   ctggag (1849680 to 1849686) = 6
ggaaaa (973056 to 973062)   ctggag (1849706 to 1849712) = 6
ggaaaa (97322 to 97328) ctggag (184962 to 184968) = 6
cctgtggataacctgtgga (1849554 to 1849572)    tccacaggttatccacagg (1849615 to 1849633) = 19
ggcccccccggagtt (470079 to 470093)  aactccgggggggcc (1849574 to 1849588) = 15
ctggag (18497062 to 18497068)   ggaaaa (9730562 to 9730568) = 6

Az első karakterlánc egy minta a zárójelben lévő minta pozícióval. A második karakterlánc ismétlődik a zárójelben lévő ismétlési pozícióval. Az első 3 sor mintája és a 6. sor ismétlése ugyanaz, de a pozíciók eltérőek. Tehát egy fürtként szeretném ezt a kimenetemmé tenni

ggaaaa==>(973026 to 973032)(973056 to 973062)(97322 to 97328)(9730562 to 9730568)   ctggag==>(1849680 to 1849686)(1849706 to 1849712)(184962 to 184968)(18497062 to 18497068)   6   8
cctgtggataacctgtgga==>(1849554 to 1849572)  tccacaggttatccacagg==>(1849615 to 1849633)  19  2
ggcccccccggagtt==>(470079 to 470093)    aactccgggggggcc==>(1849574 to 1849588)  15  2

Tehát az első karakterlánc a minta, és ezt követi a pozícióik A második karakterlánc ismétlődik, és ezt követi a pozícióik, és a TAB elválasztó a karakterlánc hossza ismét A TAB elválasztó a minta és az ismétlési pozíciók összessége

Megpróbáltam, kis fájlt kapok kimenet, de nagy fájl nem kap kimenetet. Beillesztem a kódomat alább.

my $file = $_[0];
my %hashA;
my %hashB;
my @sorted;
my $i = 1;
my $j=$k=0;
my $tmplen = $len = 0;

my @sorted = `sort -nk10 $file`;

push(@sorted,"***");

open (FLWR,">$file") or die "File can't open $!";   

$lengt = $sorted[0];
print FLWR $lengt;
my $linelen = @sorted;

while($i < $linelen)
{
    ($seqs,$len) = split(/\=/,$sorted[$i]);
    $len =~s/\s+//g;
    my($first,$second,$third,$fourth) = split(/\s+(?!to|\d+)/,$seqs);
    if($len != $tmplen ||  $sorted[$i] eq "***")
    {
        if($tmplen != 0)
        {           
            foreach $Alev2 (sort keys %{$hashA{$tmplen}})
            {
                foreach $Alev3 (sort keys %{$hashA{$tmplen}{$Alev2}})
                {
                    foreach $Blev2 (sort keys %{$hashB{$tmplen}})
                    {                           
                        foreach $Blev3 (sort keys %{$hashB{$tmplen}{$Blev2}})
                        {               
                            if($Alev3 eq $Blev3 && $Alev2 != $Blev2)
                            {           
                                ($Akey)  = keys (%{$hashA{$tmplen}{$Blev2}});                                   
                                ($Akey1)  = keys (%{$hashA{$tmplen}{$Blev2}{$Akey}});

                                foreach $Blev4 (sort keys %{$hashB{$tmplen}{$Blev2}{$Blev3}})
                                {   
                                    $hashA{$tmplen}{$Alev2}{$Alev3}{$Blev4}++;
                                    $hashB{$tmplen}{$Alev2}{$Akey}{$Akey1}++    ;
                                }
                                delete($hashB{$tmplen}{$Blev2});
                                delete($hashA{$tmplen}{$Blev2});
                            }
                        }
                    }
                }               
            }
        }
        $tmplen = $len;
    }
    if($first ne $dump_first)   
    {
        $dump_first = $first;
        $j++;       
    }

    $hashA{$tmplen}{$j}{$dump_first}{$second}++;
    $hashB{$tmplen}{$j}{$third}{$fourth}++; 

    $i++;
}

foreach $s1(sort keys %hashA) 
{
    foreach $s2 (sort keys %{$hashA{$s1}}) 
    {
        my $seq_concat = "";
        my $a_concat = "";
        my $b_concat = "";
        my $a_inc = 0;
        my $b_inc = 0;
        foreach $s3 (sort keys %{$hashA{$s1}{$s2}}) 
        {
            next if($s3 eq "");
            $Aseq_concat = "$s3==>";

            foreach $s4 (sort keys %{$hashA{$s1}{$s2}{$s3}})
            {
                $a_inc++;
                $a_concat .= $s4;
            }
        }

        $s3 = "";   
        foreach $s3 (sort keys %{$hashB{$s1}{$s2}}) 
        {
            next if($s3 eq "");

            $Bseq_concat = "$s3==>";
            foreach $s4 (sort keys %{$hashB{$s1}{$s2}{$s3}})
            {
                $b_inc++;
                $b_concat .= $s4;
            }
        }

        next if($b_concat eq "");
        $Bseq_concat = uc($Bseq_concat);
        $b_concat = uc($b_concat);
        $Aseq_concat = uc($Aseq_concat);
        $a_concat = uc($a_concat);
        if($a_inc > $b_inc)
        {   
            print FLWR $Bseq_concat.$b_concat,"\t",$Aseq_concat,$a_concat;
        }
        else
        {
            print FLWR $Aseq_concat.$a_concat,"\t",$Bseq_concat,$b_concat;
        }
        print FLWR "\t$s1\t";
        print FLWR $a_inc+$b_inc;
        print FLWR "\n";

    }
}
perl
05.05.2016

Válaszok:


1

Inkább javasolnék néhány frissítést a kódhoz, mintsem egy teljesen átdolgozott megoldást – de egyszerűen elvesztem a fenti beágyazási szinten.

Csak néhány kulcsfontosságú pont;

  1. A legjobb támadás ezzel kapcsolatban az, ha azonosítjuk, hogy a tartományok azonos formátumúak – ezért használjon regex-et „global”, /g opcióval egy while ciklusban.
  2. Miután úgy döntött, hogy a megoldást egy reguláris kifejezésre helyezi, a legjobb a „bővített mód” használata, valamint sok szóköz és megjegyzés.
  3. Az alapvető adatstruktúra kivonatokból áll. Az első szint a minta karakterláncán, a belső a tartomány specifikációs karakterláncán van kulcsolva.
  4. Az Ön specifikációja azt jelenti, hogy az adatok adott sorában lévő összes minta azonos hosszúságú lesz - az alábbiakban megadott kód erre a tényre támaszkodik.
  5. A megadott mintahosszhoz, illetve a kezdő és végpozíciókhoz kiegészítettem néhány ellenőrzést - ha sziklaszilárd az adat, lehet, hogy nincs rájuk szükség?
  6. A kért kimeneti formátum bonyolultabbá tette a kódot – ha minden mintához egy jelentéssor lenne, a kód sokkal egyszerűbb lenne. Jelenleg egy minta egy bizonyos sorszámnál jelenik meg a jelentésben, ha először jelenik meg az adatok megfelelő sorában. A minta először megjelenő sorának rögzítése jelentősen hozzáadódik a kódhoz.
  7. A kód unix szűrőstílusú – az STDIN-en keresztül biztosított és STDOUT-ra nyomtatott adatok. Hibák és figyelmeztetések az STDERR-en

Tehát, tekintettel ezekre a pontokra;

use v5.12;
use warnings;

my $pattern_regex = qr/

    (\w+)             # capture actual pattern to $1
    \s*               # optional whitespace after pattern
    (                 # capture the following to $2
        \(            # literal open bracket
        (\d+)         # capture start pos to $3
        \s* to \s*
        (\d+)         # capture end pos to $4
        \)            # literal close bracket
    )                 # close capture whole range spec to $1
    \s*               # gobble up any whitespae between patterns

/x ;                  # close regex - extended mode

my %ranges ;
my @first_seen_on_line ;

while (<>) {
    chomp ;
    my ($patterns_str, $given_length) = split /\s*=\s*/ ;
    die "No length on line $." unless defined $given_length ;

    # Repeatedly look for patterns and range-specifications
    while ( $patterns_str =~ /$pattern_regex/g )  {
        my ($pattern, $range_spec, $start_pos, $end_pos) = ($1,$2,$3,$4);
        warn "Incorrect length for '$pattern' on line $.\n"
            unless length($pattern) == $end_pos - $start_pos + 1
               &&  length($pattern) == $given_length ;

        # Is this the first time we've seen this pattern?
        if ( defined $ranges{ $pattern } )  {
            # No its not - add this range to the hash of ranges for this pattern
            $ranges{ $pattern }{ $range_spec }++ ;
        }
        else {
            # Yes it is -  record the fact that it was on this line and
            # initialize the hash of ranges for this pattern
            push @{ $first_seen_on_line[ $. ] }, $pattern ;
            $ranges{ $pattern } = { $range_spec => 1 } ;
        }
    }
}

for my $line (1 .. $#first_seen_on_line)  {
    # Might not be anything to do for this line
    next unless defined $first_seen_on_line[$line] ;

    # Get the patterns that first appeared on this line
    my @patterns =  @{ $first_seen_on_line[$line] } ;

    my ($pat_length , $range_count) ;
    for my $pat (@patterns)  {
        # Get all the ranges for this pattern and print them
        my @ranges = keys %{ $ranges{ $pat } };
        print $pat,  '==>', @ranges, "\t" ;
        $range_count += @ranges ;
        $pat_length = length($pat) ;
    }
    print $pat_length, "\t";
    print $range_count, "\n" ;
    # print length $pat, "\t", scalar @ranges, "\n" ;
}

Futott a fenti adatokra, előállítja;

gaaaa==>(973026 to 973032)(973056 to 973062)(97322 to 97328)(9730562 to 9730568)    ctggag==>(1849680 to 1849686)(1849706 to 1849712)(184962 to 184968)(18497062 to 18497068)   6   8
cctgtggataacctgtgga==>(1849554 to 1849572)  tccacaggttatccacagg==>(1849615 to 1849633)  19  2
ggcccccccggagtt==>(470079 to 470093)    aactccgggggggcc==>(1849574 to 1849588)  15  2
05.05.2016
  • Köszönöm a válaszod. Két problémával szembesülök, hogy az ismétlési pozíció néha mintapozíció. Ha a fürtözés azt jelenti, hogy egy ideig, akkor jön a duplikált pozíciópélda (1087 - 1091) (1087 - 1091) (1087 - 1091) .így módosítottam a kódodat a @ranges egyedivé tette. A másik probléma az, hogy ha az ismétlés több pozíciót hoz, azt fel kell cserélnem, hogy az ismétlés mintaként és minta ismétlésként az adott sorozatban. 07.05.2016
  • Az ismétlődő tartományok hatással vannak a sor végén lévő összegekre? Például a gggaaaa (1087 - 1091) (1087 - 1091) (1087 - 1091) azt jelenti, hogy a jelentéssor végén 7 ‹tab› 1 vagy 7 ‹tab› 3 legyen? 08.05.2016
  • Feltételezem, hogy a tartomány-specifikáció ismétlődései nem számítanak bele a sor végén lévő találatba. Frissítettem a választ úgy, hogy a tömbök kivonatát használja, így az ismétlődő tartományspecifikációk nem jelennek meg a jelentésben. Egy mellékhatás, hogy most meg van számlálva, hogy egy tartomány hányszor van megadva a bemeneten – a belső hash értékei. Az egyértelműség kedvéért ezeket az adatokat jelenleg nem használják fel. Ez a frissítés csak három sort módosít. 08.05.2016
  • gggaaaa (1087 - 1091) (1087 - 1091) (1087 - 1091) A 7‹tab›1 helyes, én is kaptam választ. módosította a $end_pos - $start_pos kódot az 1 eltávolításához. az én kódolásomban nem működik, ha hozzáadok 1-et, akkor működik. miért kell eltávolítani ezt az 1-et, csak 1-et kell hozzáadni. Ha a patten jöjjön több pozícióba, és cserélje fel a mintát, és ismételje meg azt, ahol változtatnom kell, meg tudná magyarázni, mert rosszul adtam meg az első parancsot 08.05.2016
  • Köszönöm, hogy megtaláltad a hibámat – hiba volt. Visszatettem a kódba. Nem tudom, mit kérdez – a belső adatstruktúra most egy hash, tehát ha egy tartomány megismétlődik, az nem hoz létre új kulcsot a hashben – csak növeli az értéket. Amikor jelentést készítünk, keys %{ $ranges{ $pat } } kérésével kapunk egy listát a tartományokról, így az ismétlődő tartományok nem jelennek meg a jelentésben. 09.05.2016
  • az én mintám gaaaa==›(973026-973032)(973056-973062), az ismétlés pedig ctggag==›(1849680-1849686) . így ennek az esetmintának több pozíciója van, mint ismétlés. ezért fel kell cserélnem az ismétlődő minta és az ismétlés minta tartalmat, így az eredmény a minta ctggag==›(1849680–1849686) az ismétlés gaaaa==›(973026–973032)(973056–973062). szóval hogyan tudnám összehasonlítani és cserélni 09.05.2016
    • Új anyagok
    A rádiógomb ellenőrzött eseményének használata a jQueryben
    Ebben a cikkben látni fogjuk, hogyan kell dolgozni a jquery választógombbal ellenőrzött eseményeivel. A választógombok HTML gombok, amelyek segítenek kiválasztani egyetlen értéket egy csoportból...
    Körkörös függőségek megoldása terraformban adatforrásokkal – lépésről lépésre
    Mi az a körkörös függőségek Dolgozzunk egy egyszerű eseten, amikor az SQS-sor és az S3-vödör közötti körkörös függőség problémája van egy egymástól függő címkeérték miatt. provider..
    Miért érdemes elkezdeni a kódolást 2023-ban?
    01100011 01101111 01100100 01100101 — beep boop beep boop Világunk folyamatosan fejlődik a technológia körül, és naponta fejlesztenek új technológiákat a valós problémák megoldására. Amint..
    🎙 Random Noise #2  – Örökbefogadás és hit
    az analitika íratlan világának gondozása Szeretné, hogy ezek a frissítések a postaládájába kerüljenek? Iratkozzon fel itt . "Ha önvezető autókat gyártanak, akkor mi miért ne..
    A legrosszabb politika és prediktív modellek májátültetésre jelöltek számára az Egyesült Államokban
    A máj (vagy óangolul lifer) az emberi test legnehezebb belső szervére utal, amely csendesen működik a nap 24 órájában. Mit csinál a máj? 500 feladatot hajt végre a szervezet egészségének..
    5 webhely, amely 2022-ben fejleszti front-end fejlesztői készségeit
    Frontendmentor.io A tényleges projektek létrehozásával a Frontendmentor.io segítséget nyújt a front-end kódolási képességeinek fejlesztésében. A kódolást azután kezdheti meg, hogy..
    Mikor kell használni a Type-t az interfészhez képest a TypeScriptben?
    A TypeScript a JavaScript gépelt szuperkészlete, amely statikus gépelést ad a nyelvhez. Ez megkönnyíti a robusztus és karbantartható kód írását azáltal, hogy a hibákat a fordítási időben..