Perl Test

From RtMF (Quinn Storm), 9 Months ago, written in Perl, viewed 108 times. This paste is a reply to Perl Test from RtMF (Quinn Storm) - view diff
URL http://paste.beautifulsunrise.org/view/a4fe43b7 Embed
Download Paste or View Raw
  1. #!/usr/bin/perl
  2.  
  3. use strict;
  4.  
  5. # question 1
  6. print "Question #1\n";
  7. if (@ARGV) {
  8.     my %char_freq;
  9.     foreach my $c (split //, $ARGV[0]) {
  10.         $char_freq{$c}++;
  11.     }
  12.     foreach my $c (sort { $char_freq{$b} <=> $char_freq{$a} or $a cmp $b} keys %char_freq) {
  13.         printf "%s: %s\n",$c,"#" x $char_freq{$c};
  14.     }
  15. }
  16.  
  17. # question 2
  18. print "\nQuestion #2\n";
  19. my %last_name = (
  20.     "Mary"      => "Li",
  21.     "James"     => "O Day",
  22.     "Thomas"    => "Miller",
  23.     "William"   => "Garcia",
  24.     "Elizabeth" => "Davis",
  25. );
  26. foreach my $name (sort { length $last_name{$a} <=> length $last_name{$b} or $a cmp $b } keys %last_name) {
  27.     printf "%s %s\n", $name, $last_name{$name};
  28. }
  29.  
  30. # question 3
  31. print "\nQuestion #3\n";
  32. sub balanced {
  33.     my @result;
  34.     my %match = (
  35.         "(" => ")",
  36.         "[" => "]",
  37.         "{" => "}",
  38.         );
  39.     foreach my $string (@_) {
  40.         my $result=1;
  41.         my @stack;
  42.         foreach my $c (split //,$string) {
  43.             if (defined $match{$c}) {
  44.                 push @stack, $match{$c};
  45.             } elsif ($c ne pop @stack) {
  46.                 $result=0;
  47.                 last;
  48.             }
  49.         }
  50.         push @result,$result;
  51.     }
  52.     return @result;
  53. }
  54.  
  55. my @test_strings=("([])", "[]{}", "([)]", "](){");
  56. my @test_results=balanced(@test_strings);
  57. foreach my $i (0 .. $#test_strings) {
  58.     printf "\"%s\": %s\n",$test_strings[$i], $test_results[$i]?"balanced":"unbalanced";
  59. }
  60.  
  61. # question 4
  62. print "\nQuestion #4\n";
  63. # Rather than keeping track of individual contexts, one only needs to maintain
  64. # a running nested count, and return unbalanced if either that count ever goes
  65. # below 0, or if that count is non-zero at the end of the string.
  66. sub balanced_paren {
  67.     my @result;
  68.     foreach my $string (@_) {
  69.         my $result=1;
  70.         my $depth=0;
  71.         foreach my $c (split //,$string) {
  72.             if ($c eq "(") {
  73.                 $depth++;
  74.             } elsif ($c eq ")") {
  75.                 $depth--;
  76.                 if ($depth lt 0) {
  77.                     $result=0;
  78.                     last;
  79.                 }
  80.             }
  81.         }
  82.         if ($depth gt 0) {
  83.             $result = 0;
  84.         }
  85.         push @result,$result;
  86.     }
  87.     return @result;
  88. }
  89. my @paren_strings=("(())","(()(");
  90. my @paren_results=balanced_paren(@paren_strings);
  91. foreach my $i (0 .. $#paren_strings) {
  92.     printf "\"%s\": %s\n",$paren_strings[$i], $paren_results[$i]?"balanced":"unbalanced";
  93. }
  94.  
  95. #question 5
  96. print "\nQuestion #5:\n";
  97. sub strip_line_comments {
  98.     my $input = join "\n", @_;
  99.     my $result = "";
  100.     foreach my $line (split /\n/,$input) {
  101.         my $in_string=0;
  102.         my $in_escape=0;
  103.         my $in_unicode=0;
  104.         my $in_slash=0;
  105.         foreach my $c (split //,$line) {
  106.             if ($in_unicode gt 0) {
  107.                 if (index "0123456789ABCDEFabcdef",$c ne -1) {
  108.                     $in_unicode--;
  109.                 } else {
  110.                     $in_unicode=0;
  111.                 }
  112.                 if ($in_unicode eq 0) {
  113.                     $in_escape=0;
  114.                 }
  115.             } elsif ($in_escape eq 1) {
  116.                 if ($c eq "u") {
  117.                     $in_unicode=4;
  118.                 } else {
  119.                     $in_escape=0;
  120.                 }
  121.             } elsif ($in_string eq 1) {
  122.                 if ($c eq "\\") {
  123.                     $in_escape=1;
  124.                 } elsif ($c eq "\"") {
  125.                     $in_string=0;
  126.                 }
  127.             } elsif ($c eq "\"") {
  128.                 $in_string=1;
  129.             } elsif ($c eq "/") {
  130.                 if ($in_slash eq 1) {
  131.                     $result=substr $result,0,-1;
  132.                     last;
  133.                 } else {
  134.                     $in_slash=1;
  135.                 }
  136.             } else {
  137.                 $in_slash=0;
  138.             }
  139.             $result="$result$c";
  140.         }
  141.         $result="$result\n";
  142.     }
  143.     return $result;
  144. }
  145. my @json_test=(
  146.     '// this is a comment',
  147.     '{ // another comment',
  148.     '   true, "foo", // 3rd comment',
  149.     '   "http://www.ariba.com" // comment after URL',
  150.     '}',
  151.     );
  152. printf "Input JSON:\n%s\n",join "\n",@json_test;
  153. printf "Stripped JSON:\n%s",strip_line_comments(@json_test);

Reply to "Perl Test"

Here you can reply to the paste above