Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

coloring patterns of an array

by Tony1 (Novice)
on Feb 05, 2007 at 05:33 UTC ( #598254=perlquestion: print w/ replies, xml ) Need Help??
Tony1 has asked for the wisdom of the Perl Monks concerning the following question:

hai monks,
#!/usr/bin/perl print "content-type:text/html\n\n"; use CGI; $cgi=new CGI; $search=$cgi->param('search'); $search='SSSS';# it may be any patterns like AAAA,ADLSD etc., $search='SIVA'; $count=0; print "<html><title>Search String in SWISS-PROT</title><head><center>< +h3><b><font face=courier size=5 color=green> Matching String Position + in SWISS-PROT </font></h3></center><hr>"; print "<pre><p align=left><font face=courier size=4 color=green>\t\t\t + Searched String is </font><b><font face=courier color=red +size=4 style=\"BACKGROUND-COLOR: white\">$search</font></b></p></pre> +"; print "<style type=\"text/css\">"; print "a { text-decoration:none; }"; print "</style></head>"; print "<body bgcolor=aliceblue alink=black>"; $patterlength=length($search); print "<pre>"; @arrat2 = (); #@array2 = $_; @array2=("MASVKSSSSSSSSSFISLLLLSIVAIAAAALLVIVLQAAAASQVIECQ +PQQSCTASLTGSIVALNVCAPFLVPGSIVASPTASADLSDTECCNAVADLSDQSINHDCMCNTMRIAAQ +IPAQCNLPPLSCSANSSS"); $result=index($array2[$i],$search); while ($result != -1) { $offset = $result + 1; push(@start1,$offset); push(@start,($offset-1)); $result = index($array2[$i1], $search, $offset); $result2= $offset +(length($search)); push(@end1,$result2); push(@end,$result2-1); print "<b><font face=courier size=4 color=green>Matching Position </fo +nt><font color=red>[",$offset," - ",$result2,"]</font></b>\n"; } if (defined $array2[0]) { @arr = split('',$array2[0]); } print "<font size=4 face=courier>";$ss=0; for(local $j=0;$j<=$#start;$j++) { for(local $i=$ss;$i<=$#arr;$i++) { if($start[$j] == -1) {next;} if($i % 10 == 0) { print " ";} if($i % 60 == 0) {print "<br>";} if($start[$j] != $i && $i<$start[$j]) { print "$arr[$i]"; } if($start[$j] == $i) { line: $k=$i; do { if($k % 10 == 0 && $k != $start[$j]) { print " "; } if($k % 60 == 0 && $k != $start[$j]) { print "<br>"; } print "<FONT style=\"BACKGROUND-COLOR: blue \" color=white><b><blink> +$arr[$k]</blink></b></font>";$k++; }until($end[$j] == $k || $end[$j+1] == $k );$ss=$k; if($k-1 == $start[$j+1]) { $i=($start[$j+1])+1; $j=$j+1;goto line; } elsif($k-1>$start[$j+1] && $j <$#start) { $i=$k; $j=$j+1;goto line; } else {last;} } } } for(local $i=$k;$i<$#arr;$i++) { if($i % 10 == 0) { print " ";} if($i % 60 == 0 ) {print "<br>";} print "$arr[$i]"; }@arr=(); print "</font><hr>";
By download and executing this perl program i think you may get an idea about what i am saying. Actually it is a cgi program. So, you also execute it in apache web browser.So, that you can able to understand what iam saying. i wants to minimize the above code by using regular expressions, where us right now i had solved it by using array. any suggessions please!!!!! thanks in advance, by tony1

Comment on coloring patterns of an array
Download Code
Re: coloring patterns of an array
by chargrill (Parson) on Feb 05, 2007 at 05:43 UTC

    First, that looks like a scalar to me, not an array. An array looks like this in perl:

    @array = ( 'M', 'A', 'S', 'K', ...);

    Second, what have you tried?

    I immediately think to use a regular expression, wherein I would match 3 or more repeating 'S' characters, capture that match, and surround the match by your font tags in the right hand side of said regular expression.

    Look into s/// in "Regexp quote-like operators" at perlop. In particular, pay attention to the use of capturing parenthesis (), the special $1 backreference variable, the {} quantifiers (specifically look for "Match at least n times"), and the /g global modifier.

    After you've given it an effort, and if you're still having trouble, let us know - we'll be happy to help.

    Update: Taking a second look, you'll also need to decide if you want to add spaces, as you have in your example, or whether that was a typo.



    --chargrill
    s**lil*; $*=join'',sort split q**; s;.*;grr; &&s+(.(.)).+$2$1+; $; = qq-$_-;s,.*,ahc,;$,.=chop for split q,,,reverse;print for($,,$;,$*,$/)
Re: coloring patterns of an array
by Samy_rio (Vicar) on Feb 05, 2007 at 05:51 UTC

    Hi Tony1, try like this

    use strict; use warnings; my $str = 'mASVKSSSSSSSSSFISLLLLILLVIVLQSQVIECQPQQSCTASLTGLNVCAPFLVPGS +PTASTECCNAVQSINHDCMCNTMRIAAQIPAQCNLPPLSCSANSSS'; $str =~ s/(.{10})/$1 /g; $str =~ s/(S{3,})/<font color=red>$1<\/font>/g; $str =~ s/<\/font> <font color=red>/ /g; print $str; __END__ Output is: ---------- mASVK<font color=red>SSSSS SSSS</font>FISLLL LILLVIVLQS QVIECQPQQS CTA +SLTGLNV CAPFLVPGSP TASTECCNAV QSINHDCMCN TMRIAAQIPA QCNLPPLSCS AN<fon +t color=red>SSS</font>

    Look into this How (Not) To Ask A Question

    chargrill++

    Regards,
    Velusamy R.


    eval"print uc\"\\c$_\""for split'','j)@,/6%@0%2,`e@3!-9v2)/@|6%,53!-9@2~j';

Re: coloring patterns of an array
by marto (Chancellor) on Feb 05, 2007 at 09:58 UTC
    Tony1,

    This looks very similar to your previous post color a letter in an array. Was there anything covered in the replies to your previous question that you did not understand?

    Martin
Re: coloring patterns of an array
by johngg (Abbot) on Feb 05, 2007 at 10:04 UTC
    Hi Tony1,

    You've asked a very similar question here before. What didn't you understand about the advice you were given before when looking at this new problem? You still seem to be confusing strings and arrays. Perhaps you should take a little time to read perldata which will explain Perl's different data types.

    Cheers,

    JohnGG

      hi JohnGG, U r correct and also i am sorry i don't know how to view the previous question nodes so that only i had created a new node, but right know i had known the way to view the previous node, and my problem is if the pattern occurs more than once in a single array then it's not coloring that part if patter in like 'SSS' and the matching position in that array is 'SSSSSSSSSSSSS' than the entier 'SSS' should be colored for me. example
      MMRGFKQRLI KKTTGSSSSS SSKKKDKEKE KEKSSTTSST SKKPASASSS SHGTTHSSAS STGS +KSTTEK GKQSGSVPSQ GKHHSSSTSK TKTATTPSSS SSSSRSSSVS RSGSSSTKKT SSRKGQE +QSK QSQQPSQSQK QGSSSSSAAI MNPTPVLTVT KDDKSTSGED HAHPTLLGAV SAVPSSPISN + ASGTAVSSDV ENGNSNNNNM NINTSNTQDA NHASSQSIDI PRSSHSFERL PTPTKLNPDT DL +ELIKTPQR HSSSRFEPSR YTPLTKLPNF NEVSPEERIP LFIAKVDQCN TMFDFNDPSF DIQGKEIKRS TLDELIEFLV TNRFTYTNEM YAHVVNMFKI NLFRPIPPPV NPVG +DIYDPD EDEPVNELAW PHMQAVYEFF LRFVESPDFN HQIAKQYIDQ DFILKLLELF DSEDIRE +RDC LKTTLHRIYG KFLSLRSFIR RSMNNIFLQF IYETEKFNGV AELLEILGSI INGFALPLKE + EHKVFLVRIL IPLHKVRCLS LYHPQLAYCI VQFLEKDPLL TEEVVMGLLR YWPKINSTKE IM +FLNEIEDI FEVIEPLEFI KVEVPLFVQL AKCISSPHFQ VAEKVLSYWN NEYFLNLCIE NAEVILPIIF PALYELTSQL ELDTANGEDS ISDPYMLVEQ AINSGSWNRA IHAM +AFKALK IFLETNPVLY ENCNALYLSS VKETQQRKVQ REENWSKLEE YVKNLRINND KDQYTIK +NPE LRNSFNTASE NNTLNEENEN DCDSEIQ
      in the above exaple output the patter 'SSS' should be colored until it matches 'SSS'in that array but it colors only 'SSS' if the pattern is other than 'SS' such as 'AAAA' then it should color the given pattern as 'AAA' and also other pattern like 'AAAAA' and so on.but it should color the patterns which have equal length and also greater than the orignal pattern length if u not able to understand , please reply me immediately,
        If you wish to match three or more "S"s then you can use the pattern /S{3,}/ and if you wanted to match, say, three to six of them then do /S{3,6}/. If you want to replace more than one occurrence of something in a string then make your substitution global by using the g modifier. Here is a bit of code to illustrate these points. Note that I capture the "S"s that I match using parentheses, "(" and ")", then use what I captured in the substitution as $1.

        $ perl -le ' -> $str = q{sfSSSfsdSSSSSseSShySSSScvbcv}; -> print $str; -> $str =~ s{(S{3,})}{<tag>$1</tag>}g; -> print $str;' sfSSSfsdSSSSSseSShySSSScvbcv sf<tag>SSS</tag>fsd<tag>SSSSS</tag>seSShy<tag>SSSS</tag>cvbcv $

        To look at previous nodes you have written go to your home node (you will see a "Tony1" link at the top of each page in the Monastery) and on that page you will see a link with the label "Writeups" next to it; click that and you will see all of your previous nodes.

        I hope this helps you.

        Cheers,

        JohnGG

        Update: Fixed typos.

        "Hi" not "hai", "you" not "U", "are" not "r", "I" not "i"! And there are supposed to be spaces after ' or . and there's supposed to be a capital letter after a fullstop. Why do you expect anyone to spend time decrypting that mess if you apparently can't be bothered to spell right, capitalize correctly, use spaces and explain what are you trying to acomplish? If you program the way you write I'm not surprised the computer doesn't have the slightest idea what do you mean.

        Once you can explain in detail what exactly do you want you can get really helpful replies. Or even explain your task to the computer.

        P.S.: No, guys, this is not a matter of being nasty to a non native speaker who's struggling with the language. I don't mind the "if you can't able to understand" or "replay" instead of "reply" ... mistakes like that are to be expected. I just dislike the people who can't be bothered. To spell, to format, to explain, to think.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://598254]
Approved by chargrill
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (13)
As of 2014-09-17 17:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (92 votes), past polls