Advertisement
Guest User

Untitled

a guest
Nov 26th, 2014
187
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 2.68 KB | None | 0 0
  1. use Data::Dumper;
  2. use List::Util qw/sum/;
  3. use strict;
  4.  
  5. my $db={};
  6. my $texts={};
  7.  
  8. sub words($){
  9.     my($text)=@_;
  10.    
  11.     my(@lcwords,@whitespace,@words);
  12.    
  13.     while($text=~/(\w+)(\W*)/g){
  14.         push @lcwords,lc $1;
  15.         push @whitespace,$2;
  16.         push @words,$1;
  17.     }
  18.    
  19.     \@lcwords,\@whitespace,\@words
  20. }
  21.  
  22. sub process($$){
  23.     my($title,$text)=@_;
  24.    
  25.     return if $texts->{$title};
  26.     $texts->{$title}=$text;
  27.    
  28.     my $position=0;
  29.     my($words,$whitespace)=words $text;
  30.     for(@$words){
  31.         $db->{$_}->{$title}||=[];
  32.         push @{ $db->{$_}->{$title} },$position++;
  33.     }
  34. }
  35.  
  36. sub find0($$$$){
  37.     my($index,$words,$title,$startPosition)=@_;
  38.     return if $index>=@$words;
  39.  
  40.     my $word=$words->[$index];
  41.    
  42.     my $best=-1;
  43.     my @bestRes=(-1);
  44.     for my $position(@{$db->{$word}->{$title}}){
  45.         $startPosition=$position if $index==0;
  46.         next if $position<$startPosition;
  47.        
  48.         my(@res)=find0($index+1,$words,$title,$position);
  49.         my $endPosition=$res[-1];
  50.         next if $endPosition==-1;
  51.        
  52.         if($best==-1 || $endPosition-$startPosition<$best){
  53.             $best=$endPosition-$startPosition;
  54.             @bestRes=($position,@res);
  55.         }
  56.     }
  57.  
  58.     @bestRes
  59. }
  60.  
  61. sub find($){
  62.     my($line)=@_;
  63.     my($words)=words $line;
  64.     my(@titles)=grep{ my $name=$_; @$words==sum map{ defined $db->{$_}->{$name}?1:0 } @$words } keys %$texts;
  65.    
  66.     my @res;
  67.  
  68.     for(@titles){
  69.         my @data=find0 0,\@$words,$_,-1;
  70.         my %map=map{$_=>1}@data;
  71.        
  72.         my $match;
  73.         my $length;
  74.         my(undef,$whitespace,$words)=words $texts->{$_};
  75.         for($data[0]..$data[-1]){
  76.             $match.="<b>" if $map{$_};
  77.             $match.=$words->[$_],$length+=length $words->[$_];
  78.             $match.="</b>" if $map{$_};
  79.             $match.=$whitespace->[$_],$length+=length $whitespace->[$_] if $_!=$data[-1];
  80.         }
  81.        
  82.         $match=~s/\n/ [newline] /gs;
  83.         push @res,{title=>$_,text=>$match,score=>$length};
  84.     }
  85.    
  86.     [sort{$a->{score} <=> $b->{score}}@res]
  87. }
  88.  
  89. process "Elvis Presley - What's She Really Like",<<HERE;
  90. You're asking if she loves me
  91. Well, you don't know the half
  92. You're wondering if she'll leave me
  93. Ha, ha, ha, don't make me laugh
  94. HERE
  95.  
  96. process "Bonnie Raitt - Any Day Woman Lyrics",<<HERE;
  97. If she's a woman, she'll try to make it last
  98. If you're a man now you'd better end it fast
  99. There's no reason here, no treason here
  100. Just the way a woman's mind, well she has no name
  101. She has no shame, she just loves you
  102. HERE
  103.  
  104. process "Beatles - She Loves You",<<HERE;
  105. She loves you, yeah, yeah, yeah
  106. She loves you, yeah, yeah, yeah
  107. She loves you, yeah, yeah, yeah, yeah
  108.  
  109. You think you lost your love
  110. When I saw her yesterday
  111. It's you she's thinking of
  112. And she told me what to say
  113. She says she loves you
  114. And you know that can't be bad
  115. Yes, she loves you
  116. And you know you should be glad
  117. HERE
  118.  
  119. print Dumper find "she loves you";
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement