delphi mergesort for string arrays [closed]

Answer 1

1. You'd need to modify the declaration TSortArray from array of double to array of string (or array of MyRecord)

   The comparison routines in the Merge nested proc needs to be made compatible for strings. Check for anywhere that determines whether AVal[x] < / > AVal[y]. Delphi has procedures for this (AnsiCompareText / AnsiCompareStr depending on whether you want case-sensitivity)

   That should work, but if you hadn't done this in your earlier attempts then Delphi should have complained about type mismatches rather than giving an AV, so there may be something else going on

2. I think duplicate checking should be done post-sort - it only requires one scan through of the data

3. If you want to store original index data then you will probably need to use an array of record (data: string; OriginalIndex: integer). Code in the Merge procedure then needs to be modified to pass Vals[x].Data to comparison routines. Filling the OriginalIndex values will be a quick scan before calling the Merge procedure

4. Not 100% sure, to be honest - it's easier to move large contiguous chunks of data with linked lists than with arrays, and arrays don't need messing about with pointers. If your dataset is sufficiently large you may even need to resort to streaming to disk which is likely to drive your choice more than either of those points.

Answer 2

Answer to the second question: Mergesort modification with duplicate deleting. Should work for strings.

//returns new valid length
function MergeSortRemoveDuplicates(var Vals: array of Integer):Integer;
var
  AVals: array of Integer;

   //returns index of the last valid element
  function Merge(I0, I1, J0, J1: Integer):Integer;
  var
    i, j, k, LC:Integer;
  begin
    LC := I1 - I0;
    for i := 0 to LC do
      AVals[i]:=Vals[i + I0];
      //copy lower half or Vals into temporary array AVals

    k := I0;
    i := 0;
    j := J0;
    while ((i <= LC) and (j <= J1)) do
    if (AVals[i] < Vals[j]) then begin
      Vals[k] := AVals[i];
      inc(i);
      inc(k);
    end else  if (AVals[i] > Vals[j]) then begin
      Vals[k]:=Vals[j];
      inc(k);
      inc(j);
    end else begin //duplicate
      Vals[k] := AVals[i];
      inc(i);
      inc(j);
      inc(k);
    end;

    //copy the rest
    while i <= LC do begin
      Vals[k] := AVals[i];
      inc(i);
      inc(k);
    end;

    if k <> j then
      while j <= J1 do begin
        Vals[k]:=Vals[j];
        inc(k);
        inc(j);
      end;

    Result := k - 1;
  end;

 //returns index of the last valid element

  function PerformMergeSort(ALo, AHi:Integer): Integer; //returns
  var
    AMid, I1, J1:Integer;
  begin

  //It would be wise to use Insertion Sort when (AHi - ALo) is small (about 32-100)
    if (ALo < AHi) then
    begin
      AMid:=(ALo + AHi) shr 1;
      I1 := PerformMergeSort(ALo, AMid);
      J1 := PerformMergeSort(AMid + 1, AHi);
      Result := Merge(ALo, I1, AMid + 1, J1);
    end else
      Result := ALo;
  end;

begin
  SetLength(AVals, Length(Vals) div 2 + 1);
  Result := 1 + PerformMergeSort(0, High(Vals));
end;


//short test
var
  A: array of Integer;
  i, NewLen: Integer;
begin
  Randomize;
  SetLength(A, 12);
  for i := 0 to High(A) do
    A[i] := Random(10);
   NewLen := MergeSortRemoveDuplicates(A);
   SetLength(A, NewLen);
   for i := 0 to High(A) do
     Memo1.Lines.Add(IntToStr(A[i]))
  end;

Simple modification for strings:

function MergeSortRemoveDuplicates(var Vals: array of String):Integer;
var
  AVals: array of String;

and test case:

var
  List: TStringList;
  Arr: array of string;
  i, n: Integer;
begin
  with TStringList.Create do try
    LoadFromFile('F:\m2.txt'); //contains some equal strings
    SetLength(Arr, Count);
    for i := 0 to Count - 1 do
      Arr[i] := Strings[i];
  finally
    Free
  end;
  n := MergeSortRemoveDuplicates(Arr);
  for i := 0 to n - 1 do
    Memo1.Lines.Add(Arr[i]);
end;