Merge pull request #2464 from shawnw/challenge-081-solution

Challenge 081 solution

7 files changed, 199 insertions, 0 deletions

diff --git a/challenge-081/shawn-wagner/ocaml/Makefile b/challenge-081/shawn-wagner/ocaml/Makefile
new file mode 100644
index 0000000000..c3a8f32410
--- /dev/null
+++ b/challenge-081/shawn-wagner/ocaml/Makefile
@@ -0,0 +1,20 @@
+.PHONY: all clean opt
+
+all: ch1 ch2
+
+opt: ch1x ch2x
+
+ch1: ch1.ml
+	ocamlc -o ch1 ch1.ml
+
+ch2: ch2.ml
+	ocamlc -o ch2 str.cma ch2.ml
+
+ch1x: ch1.ml
+	ocamlopt -o ch1x ch1.ml
+
+ch2x: ch2.ml
+	ocamlopt -o ch2x str.cmxa ch2.ml
+
+clean:
+	rm -f ch1 ch2 ch1x ch2x *.cmo *.cmi *.cmx *.o
diff --git a/challenge-081/shawn-wagner/ocaml/ch1.ml b/challenge-081/shawn-wagner/ocaml/ch1.ml
new file mode 100644
index 0000000000..71306a0770
--- /dev/null
+++ b/challenge-081/shawn-wagner/ocaml/ch1.ml
@@ -0,0 +1,34 @@
+(* My other solutions use hash tables; let's use a set here instead *)
+module StringSet = Set.Make(String)
+
+let substrings s =
+  let subs = ref StringSet.empty in
+  let len = String.length s in
+  for start = 0 to len - 1 do
+    for slen = 1 to len - start do
+      subs := StringSet.add (String.sub s start slen) !subs
+    done
+  done;
+  !subs
+
+let repeat s n =
+  let len = String.length s in
+  let newlen = len * n in
+  String.init newlen (function i -> String.get s (i mod len))
+
+(* And a non-regular epxression test *)
+let ismadeof s sub =
+  let reps = (String.length s) / (String.length sub) in
+  String.equal (repeat sub reps) s
+
+let task1 a b =
+  let subs = StringSet.inter (substrings a) (substrings b) in
+  let f sub =
+    if ismadeof a sub && ismadeof b sub then
+      Printf.printf "%s " sub in
+  StringSet.iter f subs;
+  print_newline ()
+
+let _ =
+  task1 "abcdabcd" "abcdabcdabcdabcd";
+  task1 "aaa" "a"
diff --git a/challenge-081/shawn-wagner/ocaml/ch2.ml b/challenge-081/shawn-wagner/ocaml/ch2.ml
new file mode 100644
index 0000000000..34a9131687
--- /dev/null
+++ b/challenge-081/shawn-wagner/ocaml/ch2.ml
@@ -0,0 +1,39 @@
+let find_def tbl key def =
+  match Hashtbl.find_opt tbl key with
+  | Some x -> x
+  | None -> def
+
+let re = Str.regexp "[.\"(),]\\|--\\|'s"
+
+let strip_special word = Str.global_replace re "" word
+  
+let task2 filename =
+  let ib = Scanf.Scanning.open_in filename in
+  let words = Hashtbl.create 100 in
+  let add_word word =
+    if word <> "" then begin
+      let word = strip_special word in
+      Hashtbl.replace words word ((find_def words word 0) + 1);
+      true
+    end else
+      false in
+  while  Scanf.bscanf ib  " %s" add_word do
+    ()
+  done;
+  Scanf.Scanning.close_in ib;
+  let maxfreq = ref 0 in
+  let frequencies = Hashtbl.create (Hashtbl.length words) in
+  Hashtbl.iter (fun w count -> Hashtbl.add frequencies count w;
+                 maxfreq := max count !maxfreq) words;
+  for count = 1 to !maxfreq do
+    if Hashtbl.mem frequencies count then begin
+      Printf.printf "%d " count;
+      List.iter (function word -> Printf.printf "%s " word)
+        (List.sort String.compare (Hashtbl.find_all frequencies count));
+      print_newline()
+    end
+  done
+    
+let _ =
+  task2 "input"
+
diff --git a/challenge-081/shawn-wagner/perl/ch1.pl b/challenge-081/shawn-wagner/perl/ch1.pl
new file mode 100755
index 0000000000..cc1b41e5eb
--- /dev/null
+++ b/challenge-081/shawn-wagner/perl/ch1.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+use feature qw/say/;
+
+sub substrings :prototype($) {
+  my $s = shift;
+  my $len = length $s;
+  my %subs;
+  for my $start (0 .. $len - 1) {
+    for my $slen (1 .. $len - $start) {
+      $subs{substr $s, $start, $slen} = 1;
+    }
+  }
+  return keys %subs;
+}
+
+sub task1 :prototype($$) {
+  my ($A, $B) = @_;
+  my (@common, %subs);
+  for (substrings($A), substrings($B)) {
+    $subs{$_} += 1;
+  }
+  while (my ($substr, $count) = each %subs) {
+    next if $count != 2;
+    push @common, $substr if ($A =~ /^(?:$substr)+$/ && $B =~ /^(?:$substr)+$/);
+  }
+  say join(" ", sort @common);
+}
+
+task1 "abcdabcd", "abcdabcdabcdabcd";
+task1 "aaa", "aa";
diff --git a/challenge-081/shawn-wagner/perl/ch2.pl b/challenge-081/shawn-wagner/perl/ch2.pl
new file mode 100755
index 0000000000..ca65fa440a
--- /dev/null
+++ b/challenge-081/shawn-wagner/perl/ch2.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+use feature qw/say/;
+use experimental qw/postderef/;
+
+my %words;
+
+open my $file, "<", "input" or die "Unable to open input: $!\n";
+while (<$file>) {
+  chomp;
+  s/[."(),]|--|'s//g;
+  for my $word (split /\s+/, $_) {
+    $words{$word}++;
+  }
+}
+close $file;
+
+my %frequencies;
+while (my ($word, $count) = each %words) {
+  push @{$frequencies{$count}}, $word;
+}
+
+for my $count (sort { $a <=> $b } keys %frequencies) {
+  say $count, " ", join(" ", sort $frequencies{$count}->@*);
+}
+
diff --git a/challenge-081/shawn-wagner/tcl/ch1.tcl b/challenge-081/shawn-wagner/tcl/ch1.tcl
new file mode 100755
index 0000000000..bc0b95423b
--- /dev/null
+++ b/challenge-081/shawn-wagner/tcl/ch1.tcl
@@ -0,0 +1,27 @@
+#!/usr/bin/env tclsh
+
+proc substrings {s} {
+    set len [string length $s]
+    for {set start 0} {$start < $len} {incr start} {
+        for {set end $start} {$end < $len} {incr end} {
+            dict set substrings [string range $s $start $end] 1
+        }
+    }
+    return [dict keys $substrings]
+}
+
+proc task1 {A B} {
+    foreach substr [concat [substrings $A] [substrings $B]] {
+        dict incr subs $substr
+    }
+    dict for {substr count} $subs {
+        if {$count != 2} { continue }
+        if {[regexp "^(?:$substr)+$" $A] && [regexp "^(?:$substr)+$" $B]} {
+            lappend common $substr
+        }
+    }
+    puts [lsort $common]
+}
+
+task1 abcdabcd abcdabcdabcdabcd
+task1 aaa aa
diff --git a/challenge-081/shawn-wagner/tcl/ch2.tcl b/challenge-081/shawn-wagner/tcl/ch2.tcl
new file mode 100755
index 0000000000..6bee2cb108
--- /dev/null
+++ b/challenge-081/shawn-wagner/tcl/ch2.tcl
@@ -0,0 +1,20 @@
+#!/usr/bin/env tclsh
+
+proc task2 {input} {
+    set fp [open $input]
+    while {[gets $fp line] >= 0} {
+        regsub -all {[.""(),]|--|'s} $line "" line
+        foreach word [split $line] {
+            dict incr words $word
+        }
+    }
+    close $fp
+    dict for {word count} $words {
+        dict lappend frequencies $count $word
+    }
+    foreach count [lsort -integer [dict keys $frequencies]] {
+        puts "$count [lsort [dict get $frequencies $count]]"
+    }
+}
+
+task2 input