As if F# was not as far away from normal for me (second attempt ever), here is a FreePascal version for PIEBALDConsultant. This is my first attempt at programming with this language, so please be gentle as I am sure there is plenty of room for improvement...
Program LongestSubstringContained(output);
type
dynStrings = array of string;
procedure QuickSort(input : dynStrings; lowPos, highPos : integer);
var
movablePointer, immovablePointer, temporaryPointer : integer;
temporaryItem : string;
begin
immovablePointer := lowPos;
movablePointer := highPos;
while (movablePointer <> immovablePointer) do
begin
if(movablePointer > immovablePointer) then
begin
if(input[movablePointer] < input[immovablePointer]) then
begin
temporaryItem := input[movablePointer];
input[movablePointer] := input[immovablePointer];
input[immovablePointer] := temporaryItem;
temporaryPointer := movablePointer;
movablePointer := immovablePointer;
immovablePointer := temporaryPointer;
end
else
begin
dec(movablePointer);
end;
end
else
begin
if(input[movablePointer] > input[immovablePointer]) then
begin
temporaryItem := input[movablePointer];
input[movablePointer] := input[immovablePointer];
input[immovablePointer] := temporaryItem;
temporaryPointer := movablePointer;
movablePointer := immovablePointer;
immovablePointer := temporaryPointer;
end
else
begin
inc(movablePointer);
end;
end;
end;
if(movablePointer > lowPos) then
QuickSort(input,lowPos,movablePointer-1);
if(movablePointer < highPos) then
QuickSort(input,movablePointer+1,highPos);
end;
function TrimArray(input: dynStrings) : dynStrings;
var
i, len, count: integer;
ret: dynStrings;
begin
count := 0;
len := Length(input);
for i := 0 to len do
begin
if (Length(input[i]) > 0) then
begin
count := count + 1;
setlength(ret, count);
ret[count - 1] := input[i];
end;
end;
TrimArray := ret;
end;
function RetrieveBestResult(strings :dynStrings) : string;
var
str, tmp: string;
strLen, strCount, i, len, tmpCount: integer;
begin
tmpCount := 0;
strCount := 0;
strLen := 0;
tmp := '';
str := '';
QuickSort(strings, low(strings), high(strings));
for i := 0 to high(strings) do
begin
len := length(strings[i]);
if (len >= strLen) then
begin
strCount := 1;
str := strings[i];
strLen := len;
end
else if (str = strings[i]) then
strCount := strCount + 1
else if (tmp = strings[i]) then
tmpCount := tmpCount + 1
else
begin
tmp := strings[i];
tmpCount := 1;
end;
end;
RetrieveBestResult := str;
end;
function StrInArray(value : string; strings :dynStrings) : Boolean;
var
str : String;
begin
for str in strings do
begin
if length(value) = 0 then
exit(false);
if (value = str) then
begin
exit(true);
end;
end;
StrInArray := false;
end;
function Process(input: dynStrings) : string;
var
matches: dynStrings;
allMatches: dynStrings;
i, c, cc, count, len: integer;
str, sstr: string;
begin
setlength(allMatches, 0);
setlength(matches, 0);
for i := 0 to high(input) do
begin
str := input[i];
count := 0;
len := length(str);
for c := 0 to len do
begin
for cc := 1 to len - c do
begin
sstr := copy(str, c, cc);
if (high(allmatches) = -1) or (StrInArray(sstr, allMatches)) then
begin
count := count + 1;
setlength(matches, count);
matches[count - 1] := sstr;
end;
end;
end;
if (high(matches) < 1) then
exit('no match');
allMatches := copy(matches, 0, length(matches));
writeln('Matches found: ', high(allMatches));
setlength(matches, 0);
end;
Process := RetrieveBestResult(allMAtches);
end;
function GetLCS(input: dynStrings) : string;
var
count: integer;
work: dynStrings;
begin
count := Length(input);
if (count = 0) then
exit('empty')
else
begin
work := TrimArray(input);
count := Length(work);
if (count = 0) then
exit('empty');
end;
writeln('processing...');
GetLCS := Process(work);
end;
var
tests: array[0..4] of string;
result: string;
begin
tests[0] := 'Yes, the classic LCS problem. Given two or more strings find the longest common substring in each string.';
tests[1] := '';
tests[2] := 'One caveat: No C#, C, C++, Javascript or any C-based programming language[^], nor any VB-based language (VB, VB.NET, VBScript). That cuts out most of the easy languages. Spread your wings!';
tests[3] := '';
tests[4] := 'Your solution should take into account null strings and strings whose length is limited only by available storage.';
result := GetLCS(tests);
writeln('Longest Substring: ', result);
end.
And here is the output...
sh-4.3$ fpc -vw main.pas
Free Pascal Compiler version 2.6.4 [2015/06/17] for x86_64
Copyright (c) 1993-2014 by Florian Klaempfl and others
Target OS: Linux for x86-64
Compiling main.pas
Linking main
/usr/bin/ld: warning: link.res contains output sections; did you forget -T? 209 lines compiled, 0.1 sec
sh-4.3$ main
processing...
Matches found: 5564
Matches found: 253
Matches found: 147
Longest Substring: ings
sh-4.3$
This solution was built using the
Coding Ground[
^] online IDE. Here is a link to
the solution[
^] where you can compile and run it.
Enjoy! :)