fork download
copy 
  1. #use strict;
  2. use warnings;
  3. local $SIG{__WARN__} = sub {$w = shift};
  4. use Time::HiRes;
  5. $|++;
  6.  
  7. srand;
  8. my @lines = <>;
  9. my $n     = 50000;
  10. my $long  = '';
  11.    $long .= qw{( )}[ int(rand() * 2) ] for 1 .. $n;
  12.  
  13. push @lines, $long;
  14.  
  15. my @lines2 = @lines;
  16.  
  17. my $start = Time::HiRes::time();
  18.  
  19. my $depth = 40;
  20. my $pre_regex2 = '(?:\((?:\d+,)*(?:\)|' x $depth . '(?!)' . '\)))+' x $depth;
  21. #	(?:
  22. #		\(
  23. #			(?:\d+,)*	(?:
  24. #							\)
  25. #							|
  26. #							(?!)\)
  27. #						)
  28. #	)+
  29. my $regex2 = qr/$pre_regex2/;
  30. my $regex3 = qr/(?:\d+,){2,}/;
  31.  
  32. for my $string (@lines2){
  33.  
  34. 	while ( 
  35. 		$string =~ s/$regex2/
  36. 			$a=$&,
  37. 			$b=()=$a=~m{[)(]}g,
  38. 			$a=~s{\d+,}{$b+=$&,''}eg,
  39. 			"$b,"
  40. 			/eg 
  41. 		or
  42. 		$string =~ s/$regex3/
  43. 			$a=$&,
  44. 			$b=0,
  45. 			$a=~s{\d+,}{$b+=$&,''}eg,
  46. 			"$b,"
  47. 			/eg 
  48. 		)
  49. 		{}
  50. 	my @groups = $string =~ m/\d+/g;
  51. 	my $max=0;
  52. 	for my $group (@groups){
  53. 		$max < $group and $max = $group
  54. 		}
  55. 	my $occ = 0;
  56. 	for my $group (@groups){
  57. 		$occ += $max == $group
  58. 		}
  59. 	$max or $occ=1;
  60. 	print "$max $occ\n";
  61. 	}
  62.  
  63. print Time::HiRes::time() - $start, $/;
  64.  
  65. $start = Time::HiRes::time();
  66.  
  67. my $regex =
  68. qr{
  69.     \(                  # match an opening parenthesis
  70.          (?0)*          # recurse to capture full pattern
  71.     \)                  # match a closing parenthesis
  72. }x;
  73.  
  74. for my $string (@lines)
  75. {
  76.     my $max    = 0;
  77.     my $occ    = 1;
  78.  	my @groups = ();
  79.     my $pred = -1;
  80.     my $i = 0;
  81.     while ($string =~ m/$regex/g){
  82.     	$pred == $-[0] or $i++;
  83.     	$groups[$i] += $+[0] - $-[0];
  84.     	$pred = $+[0];
  85.     	}
  86.  
  87.     if (@groups)
  88.     {
  89.         @groups = sort {    $a <=>    $b } @groups;
  90.         $max =    $groups[-1];
  91.  
  92.         for my $i (reverse 0 .. $#groups - 1)
  93.         {
  94.             if (    $groups[$i] ==     $groups[-1])
  95.             {
  96.                 ++$occ;
  97.             }
  98.             else
  99.             {
  100.                 last;
  101.             }
  102.         }
  103.     }
  104.  
  105.     print "$max $occ\n";
  106. }
  107.  
  108. print Time::HiRes::time() - $start, $/;
  109.  
  110. __DATA__
  111. )((())))(()())
  112. ))(
  113. ()(())()
  114. ((((()(((
  115. (()())()(())()()())())()((()(()(())()()())((()(())()(()()()()))()(())()(((()())()(()((())()(())(()))
  116.  
Success #stdin #stdout #stderr 3.5s 10424KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
10446 1
0.467826843261719
10446 1
3.02168297767639
stderr
copy 
Name "main::w" used only once: possible typo at prog.pl line 3.
https://ideone.com/K12225
language:
Perl (perl 5.28.1)
created:
9 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!