Add /r/dailyprogrammer Challenge #305

2 files changed, 152 insertions, 0 deletions

diff --git a/daily/305intermediate/README.md b/daily/305intermediate/README.md
new file mode 100644
index 0000000..b1854b9
--- /dev/null
+++ b/daily/305intermediate/README.md
@@ -0,0 +1,53 @@
+# [[2017-03-08] Challenge #305 [Intermediate] The Best Conjunction](https://www.reddit.com/r/dailyprogrammer/comments/5yaiin/20170308_challenge_305_intermediate_the_best/)
+
+## Description
+
+Your job is to find the best conjunction—that is, find the word with the most
+sub-words inside of it given a list of English words. Some example include:
+
+* Something (3 words: So, me, thing)
+* Awesomeness (3 words: awe, some, ness)
+
+## Formal Inputs & Outputs
+
+### Input description
+
+Use a [list of English words](http://www-personal.umich.edu/~jlawler/wordlist)
+and a *minimum sub-word length* (the smallest length of a sub-word in a
+conjuncted word) to find the *best conjunction* (most sub-words) in the
+dictionary!
+
+### Output description
+
+    minSize 3: disproportionateness (6: dis, pro, port, ion, ate, ness)
+    minSize 4: dishonorableness (4: dish, onor, able, ness)
+
+Find minSize 5
+
+## Notes/Hints
+
+* Be aware the file is split by `\r\n` instead of `\n`, and has some empty
+  lines at the end
+* In order to run in a reasonable amount of time, you will need an O(1) way of
+  checking if a word exists. (Hint: It won't be O(1) memory)
+* Make sure you're checking all possibilities—that is, given the word *sotto*,
+  if you begin with *so*, you will find that there is no word or combination of
+  words to create *tto*. You must continue the search in order to get the
+  conjunction of *sot* and *to*.
+
+## Bonus
+
+* Each sub-word must include the last letter of the previous subword. For
+  example *counterrevolutionary* would become *count*, *terre*, *evolution*,
+  *nary*
+* Instead of simply the last letter, allow any number of letters to be shared
+  between words (e.g. *consciencestricken* -> *conscience*, *sciences*,
+  *stricken*)
+
+## Credit
+
+This challenge was suggested by user /u/DemiPixel, many thanks!
+
+Have a good challenge idea?
+
+Consider submitting it to /r/dailyprogrammer_ideas
diff --git a/daily/305intermediate/conjunction.pas b/daily/305intermediate/conjunction.pas
new file mode 100644
index 0000000..2ff8548
--- /dev/null
+++ b/daily/305intermediate/conjunction.pas
@@ -0,0 +1,99 @@
+type
+  strarray = array of string;
+
+var
+  wordlist, a, maxa, mt: strarray;
+  i: int32;
+  size: int8 = 1;
+  s, maxs: string;
+
+
+function isnotin(
+  s: string;
+  a: strarray
+): boolean;
+
+  var
+    l, m, h: int32;
+
+  begin
+    l := 0;
+    h := length(a) - 1;
+    repeat
+      m := (l + h) div 2;
+      if s = a[m] then
+        exit(false)
+      else if s < a[m] then
+        h := m - 1
+      else
+        l := m + 1
+    until l > h;
+    isnotin := true
+  end;
+
+
+function conjunct(
+  s: string;
+  size: int8
+): strarray;
+
+  var
+    a: strarray;
+    i, j: int8;
+
+  begin
+    if s = '' then
+      exit(mt);
+    setlength(conjunct, 0);
+    for i := size to length(s) do
+      begin
+        if isnotin(copy(s, 1, i), wordlist) then
+          continue;
+        a := conjunct(copy(s, i + 1, length(s) - i), size);
+        if ((length(a) = 1) and
+            (copy(s, i + 1, length(s) - i) <> a[0])) or
+           (length(a) < length(conjunct)) then
+          continue;
+
+        setlength(conjunct, length(a) + 1);
+        for j := 1 to length(a) do
+          conjunct[j] := a[j - 1];
+        conjunct[0] := copy(s, 1, i)
+      end;
+  end;
+
+
+begin
+  setlength(wordlist, 69903); (* I know this is a bit cheaty *)
+  assign(input, 'wordlist');
+  reset(input);
+  for i := 0 to 69902 do
+    readln(wordlist[i]);
+  close(input);
+  setlength(mt, 0); (* for convenience *)
+
+  repeat
+    setlength(maxa, 0);
+    for s in wordlist do
+      begin
+        if length(s) < length(maxa) * size then
+          continue;
+        a := conjunct(s, size);
+        if length(a) > length(maxa) then
+          begin
+            setlength(maxa, length(a));
+            for i := 0 to length(a) - 1 do
+              maxa[i] := a[i];
+            maxs := s
+          end
+      end;
+    if length(maxa) = 0 then
+      break;
+
+    write('Min size ', size, ': ', maxs, ' (', length(maxa), ': ');
+    for i := 0 to length(maxa) - 2 do
+      write(maxa[i], ', ');
+    writeln(maxa[length(maxa) - 1], ')');
+    inc(size)
+  until false (* the loop should break before writing *)
+end.