Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Re^2: Problems searching and highlighting proximity words in a text

by jrc (Initiate)
on May 24, 2010 at 08:44 UTC ( #841341=note: print w/ replies, xml ) Need Help??


in reply to Re: Problems searching and highlighting proximity words in a text
in thread Problems searching and highlighting proximity words in a text

Here is an example:

#!/usr/bin/perl use strict; use warnings; use POSIX qw(locale_h); my $old_locale = setlocale(LC_CTYPE); setlocale(LC_CTYPE, 'ca_ES.iso885915@euro'); use locale; my @expressions; my $content = qq{ La mitad de las personas con VIH requiere de una atención psicológica + y emocional derivada del impacto del diagnóstico o de las consecuen +cias de la propia infección, una cifra que dobla a la de la població +n general, según las conclusiones de las IV Jornadas de Divulgación +sobre VIH que han reunido a unos doscientos profesionales, pacientes + y estudiantes en el hospital Reina Sofía de Murcia. En el congreso +, organizado por Amuvih en colaboración con el servicio de Proyecció +n Social y Voluntariado de la Universidad de Murcia y Abbott, ha det +erminado que las personas que viven con VIH demandan especialmente a +tención a su salud mental para mejorar su calidad de vida, "una asig +natura pendiente a pesar de los innumerables avances farmacológicos" +. Entre otros factores, las jornadas establecieron que en la situación +de "vulnerabilidad" de las personas con VIH influyen "el propio diag +nóstico, la comunicación de su situación a los allegados, el inicio +del tratamiento, las fluctuaciones a lo largo de la infección, la pé +rdida de salud y deterioro físico, así como los efectos adversos del + tratamiento". Igualmente, otros factores importantes son la pérdida de la motivació +n, el hastío, el estigma y rechazo, así como las nuevas parejas sexu +ales, los cambios familiares, laborales y sociales, entre otras cosa +s, que derivan en "riesgo de depresión mayor, trastorno distímico, t +rastorno por ansiedad generalizada o trastorno de pánico". }; my $expression = 'abbot salud::20'; push (@expressions, $expression); foreach my $exp (@expressions) { warn "a"; my $tag = 'span'; my $class = "lighligth"; next if ($exp !~ /::/); my ($exp, $distance) = split("::", $exp); my ($par1, $par2) = split(' ', $exp); warn "Pars $par1 - $par2 - $distance"; if ($content =~ /\b($par1)(\W+(?:\w*\W*){1,$distance})?($par2)\b/i){ warn "IF 1"; my ($par1, $par2, $par3) = ($1, $2, $3); $content =~ s/$par1\Q$par2\E$par3/<$tag$class> $par1<\/$tag>$par2<$ta +g$class> $par3<\/$tag>/gi; } warn "STEP"; if ($content =~ /\b($par2)(\W+(?:\w*\W*){1,$distance})?($par1)\b/i){ warn "IF 2"; my ($par1, $par2, $par3) = ($1, $2, $3); $content =~ s/$par1\Q$par2\E$par3/<$tag$class> $par1<\/$tag>$par2<$ta +g$class> $par3<\/$tag>/gi; } warn "END"; }


Comment on Re^2: Problems searching and highlighting proximity words in a text
Download Code
Re^3: Problems searching and highlighting proximity words in a text
by Krambambuli (Deacon) on May 24, 2010 at 09:20 UTC
    If you run your code with perl -Dr (assuming your perl interpreter is compiled with debugging enabled), you'll see what I can see now too:

    the regexp engine works and works and works...

    However, I cannot see yet exactly what the solution is; at first sight, the regexp seems to be only extremely inefficient via the backtracks when it does _not_ find what it looks for.

    Update.

    A work-around to avoid the heavy backtracking when the wanted terms are not to be found in the wanted order might look like
    if ($content =~ /$par2.*$par1/i) { if ($content =~ /\b($par2)(\W+(?:\w*\W*){1,$distance})?($par1) +\b/i){ warn "IF 2"; my ($par1, $par2, $par3) = ($1, $2, $3); $content =~ s/$par1\Q$par2\E$par3/<$tag$class> $par1<\/$ta +g>$par2<$tag$class> $par3<\/$tag>/gi; } }
    That works for me, but I guess there should be some nicer solutions too.

    Update2 Looks like using a regexp like
    if ($content =~ /\b($par1)(\W+(\w+\W+){0,$distance})($par2)\b/i) {
    works OK and also avoids the excessive backtracking for unsuccessful lookups. You'll have however to add an $4 and use it instead of $3 for the extra new match introduced with this.

      Thanks for your solutions seems to work in that example and also and more I try. The $4 seems not to be necessary, at least in my case returns only three results. An example code that works with your suggestions:
        The $4 seems not to be necessary,

        Indeed, as long as you use

        (?:\w+\W+){0,$distance}

        instead of the expression I've used,

        (\w+\W+){0,$distance}

        there will be no extra match. I haven't done any benchmarking, but probably the lookahead is a bit better/faster anyway.

Re^3: Problems searching and highlighting proximity words in a text
by GrandFather (Cardinal) on May 24, 2010 at 12:35 UTC

    The following code is much more complicated than your sample, but scales reasonably for likely data and is much faster. The code breaks the data into lines of words then builds a lookup hash keyed by word and with a list of each line and word position where the word occurs. The main loop then, for each target word pair and distance, searches the two occurrence lists for the target words to see if there are any matching pairs. Note that it only allows a match if the words are in the same line and of course they must be within the correct distance of each other.

    Most of the tricky stuff is taking care of retaining the punctuation while only matching the words.

    #!/usr/bin/perl use strict; use warnings; use POSIX qw(locale_h); my $old_locale = setlocale (LC_CTYPE); setlocale (LC_CTYPE, 'ca_ES.iso885915@euro'); use locale; my $content = qq{ La mitad de las personas con VIH requiere de una atención psicológica + y emocional derivada del impacto del diagnóstico o de las consecuen +cias de la propia infección, una cifra que dobla a la de la població +n general, según las conclusiones de las IV Jornadas de Divulgación +sobre VIH que han reunido a unos doscientos profesionales, pacientes + y estudiantes en el hospital Reina Sofía de Murcia. En el congreso +, organizado por Amuvih en colaboración con el servicio de Proyecció +n Social y Voluntariado de la Universidad de Murcia y Abbott, ha det +erminado que las personas que viven con VIH demandan especialmente a +tención a su salud mental para mejorar su calidad de vida, "una asig +natura pendiente a pesar de los innumerables avances farmacológicos" +. Entre otros factores, las jornadas establecieron que en la situación +de "vulnerabilidad" de las personas con VIH influyen "el propio diag +nóstico, la comunicación de su situación a los allegados, el inicio +del tratamiento, las fluctuaciones a lo largo de la infección, la pé +rdida de salud y deterioro físico, así como los efectos adversos del + tratamiento". Igualmente, otros factores importantes son la pérdida de la motivació +n, el hastío, el estigma y rechazo, así como las nuevas parejas sexu +ales, los cambios familiares, laborales y sociales, entre otras cosa +s, que derivan en "riesgo de depresión mayor, trastorno distímico, t +rastorno por ansiedad generalizada o trastorno de pánico". }; my $tag = 'span'; my $class = "lighligth"; my @expressions = ('psicológica atención::20', 'otros hastío::11', 'pánico distímico +::8'); my @lines = map { [grep {defined $_->[1]} map {/(\w+)/; [$_, $1]} split] } split "\n", $content; my %lookup; for my $lineIdx (0 .. $#lines) { my $line = $lines[$lineIdx]; next if !@$line; push @{$lookup{lc $line->[$_][1]}}, [$lineIdx, $_] for 0 .. $#$lin +e; } foreach my $currExp (@expressions) { next if ($currExp !~ /::/); my ($exp, $distance) = split ("::", $currExp); my ($par1, $par2) = map {lc} split (' ', $exp); next if !exists $lookup{$par1} || !exists $lookup{$par2}; for my $par1Entry (@{$lookup{$par1}}) { for my $par2Entry (@{$lookup{$par2}}) { next if $par1Entry->[0] != $par2Entry->[0]; # same line + check next if abs ($par1Entry->[1] - $par2Entry->[1]) > $distanc +e + 1; my $par1Ref = \$lines[$par1Entry->[0]][$par1Entry->[1]][1] +; my $par2Ref = \$lines[$par2Entry->[0]][$par2Entry->[1]][1] +; $$par1Ref = "<$tag $class>$$par1Ref</$tag>"; $$par2Ref = "<$tag $class>$$par2Ref</$tag>"; } } } @lines = map { [map {$_->[0] =~ s/\w+/$_->[1]/; $_->[0]} @$_] } @lines; print "@{$lines[$_]}\n" for 0 .. $#lines;

    Prints:

    La mitad de las personas con VIH requiere de una <span lighligth>atenc +ión</span> <span lighligth>psicológica</span> y emocional derivada de +l impacto del diagnóstico o de las consecuencias de la propia infecci +ón, una cifra que dobla a la de la población general, según las concl +usiones de las IV Jornadas de Divulgación sobre VIH que han reunido a + unos doscientos profesionales, pacientes y estudiantes en el hospita +l Reina Sofía de Murcia. En el congreso, organizado por Amuvih en col +aboración con el servicio de Proyección Social y Voluntariado de la U +niversidad de Murcia y Abbott, ha determinado que las personas que vi +ven con VIH demandan especialmente atención a su salud mental para me +jorar su calidad de vida, "una asignatura pendiente a pesar de los in +numerables avances farmacológicos". Entre otros factores, las jornadas establecieron que en la situación d +e "vulnerabilidad" de las personas con VIH influyen "el propio diagnó +stico, la comunicación de su situación a los allegados, el inicio del + tratamiento, las fluctuaciones a lo largo de la infección, la pérdid +a de salud y deterioro físico, así como los efectos adversos del trat +amiento". Igualmente, <span lighligth>otros</span> factores importantes son la p +érdida de la motivación, el <span lighligth>hastío</span>, el estigma + y rechazo, así como las nuevas parejas sexuales, los cambios familia +res, laborales y sociales, entre otras cosas, que derivan en "riesgo +de depresión mayor, trastorno <span lighligth>distímico</span>, trast +orno por ansiedad generalizada o trastorno de <span lighligth>pánico< +/span>".
    True laziness is hard work

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (7)
As of 2014-11-28 23:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (200 votes), past polls