Results 1 to 11 of 11

Thread: Sorting strings alphabetically

  1. #1
    Join Date
    Apr 2008
    Location
    Marquette, MI
    Posts
    15,252
    Mentioned
    138 Post(s)
    Quoted
    680 Post(s)

    Default Sorting strings alphabetically

    I need to sort a string array in alphabetical order for a school assignment program. Right now, it works for the first two letters in the string. I need help making it check the next letter if necessary, and keep doing it until everything is sorted properly.

    SCAR Code:
    program Alphabetical_Sorting;

    function alpha_GetLetters(s: TStringArray; index: Integer): Array of String;
    var
      i: Integer;
    begin
      SetLength(Result, Length(s));
                   
      for i := 0 to High(s) do
        Result[i] := Lowercase(StrGet(s[i], index));
    end;

    function alpha_SortLetters(s: TStringArray; index: Integer): Array of String;
    var
      alphabet: TStringArray;
      letters: Array of String;
      letterVals: Array of Integer;
      hi, i, j: Integer;
    begin
      SetLength(Result, Length(s));
      SetLength(letterVals, Length(s));
      letters := alpha_GetLetters(s, index);
     
      alphabet := ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
                   'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
                   'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z'];

      hi := High(alphabet);
      for i := 0 to High(s) do
        for j := 0 to hi do
          if (letters[i] = alphabet[j]) then
            letterVals[i] := j;
           
      BubbleSort(letterVals);
      for i := 0 to High(letterVals) do
        for j := 0 to hi do
          if (letterVals[i] = j) then
            Result[i] := alphabet[j];
    end;

    function alpha_Occurrences(s: TStringArray; index: Integer): Array of Integer;
    var
      sorted: Array of String;
      occurrences, hi, i, j: Integer;
    begin
      SetLength(Result, 0);
      sorted := alpha_SortLetters(s, index);
     
      hi := High(sorted);
      for i := 0 to hi do
      begin
        if (i > 0) then
          if (sorted[i] = sorted[i - 1]) then
            Continue;
     
        for j := 0 to hi do
          if (sorted[i] = sorted[j]) then
            Inc(occurrences);
           
        SetLength(Result, Length(Result) + 1);
        Result[High(Result)] := occurrences;
        occurrences := 0;
      end;
    end;

    function alpha_SortWords(s: TStringArray; index: Integer): Array of String;
    var
      letters, sorted: Array of String;
      i, j, k: Integer;
    begin
      SetLength(Result, 0);
      letters := alpha_GetLetters(s, index);
      sorted := alpha_SortLetters(s, index);
         
      for j := 0 to High(sorted) do
        for k := 0 to High(letters) do
        begin
          if (InStrArr(s[k], Result, False)) then
            Continue;
           
          if (sorted[j] = letters[k]) then
          begin
            SetLength(Result, Length(Result) + 1);
            Result[High(Result)] := s[k];
          end;
        end;
    end;

    function alpha_GetDuplicates(s: TStringArray; index: Integer): Array of Array of String;
    var
      sorted: Array of String;
      occurrences: Array of Integer;
      temp, start, finish, i, j, k: Integer;
    begin
      sorted := alpha_SortWords(s, index);
      occurrences := alpha_Occurrences(sorted, index);

      for i := 0 to High(occurrences) do
      begin
        SetLength(Result, i + 1);
       
        for j := 0 to i do
          temp := temp + occurrences[j];
       
        start := (temp - occurrences[i]);
        finish := (temp - occurrences[i]) + (occurrences[i] - 1);
       
        for k := start to finish do
        begin
          SetLength(Result[i], Length(Result[i]) + 1);
          Result[i][High(Result[i])] := sorted[k];
        end;
       
        temp := 0;
      end;
    end;

    function alpha_SortDuplicates(s: TStringArray; index: Integer): Array of Array of String;
    var
      duplicates: Array of Array of String;
      i: Integer;
    begin
      duplicates := alpha_GetDuplicates(s, index);
      SetLength(Result, Length(duplicates));
     
      for i := 0 to High(duplicates) do
        Result[i] := alpha_SortWords(duplicates[i], index + 1);
    end;

    function alpha_SortStringArray(s: TStringArray): Array of String;
    var
      index, i, j: Integer;
      sorted, dupSorted: Array of String;
      duplicates: Array of Array of String;
    begin
      Inc(index);
      sorted := alpha_SortWords(s, index);
      duplicates := alpha_GetDuplicates(sorted, index);
     
      for i := 0 to High(duplicates) do
      begin
        if (Length(duplicates[i]) > 1) then
          duplicates[i] := alpha_SortWords(duplicates[i], index + 1);

        for j := 0 to High(duplicates[i]) do
        begin
          SetLength(Result, Length(Result) + 1);
          Result[High(Result)] := duplicates[i][j];
        end;
      end;
    end;

    var
      theArray, strings: Array of String;
      i: Integer;
    begin
      ClearDebug;
      strings := ['Chair', 'Bed', 'Cabnet', 'Tape', 'Book', 'Lamp', 'Light',
                  'Table', 'Shelf', 'Door', 'Binder'];
       
      theArray := alpha_SortStringArray(strings);
      for i := 0 to High(theArray) do
        Writeln(theArray[i]);
    end.
    Thanks in advance,
    Coh3n
    Last edited by Coh3n; 02-11-2010 at 10:25 PM.

  2. #2
    Join Date
    Jan 2008
    Location
    Ontario, Canada
    Posts
    7,805
    Mentioned
    5 Post(s)
    Quoted
    3 Post(s)

    Default

    Best way to do it would probably be with a recursive algorithm to sort through a single index and move through it that way.

    Not really 100% how to do it, I wish I could help you out more though.
    Writing an SRL Member Application | [Updated] Pascal Scripting Statements
    My GitHub

    Progress Report:
    13:46 <@BenLand100> <SourceCode> @BenLand100: what you have just said shows you 
                        have serious physchological problems
    13:46 <@BenLand100> HE GETS IT!
    13:46 <@BenLand100> HE FINALLY GETS IT!!!!1

  3. #3
    Join Date
    Sep 2006
    Posts
    6,089
    Mentioned
    77 Post(s)
    Quoted
    43 Post(s)

    Default

    SCAR Code:
    program New;


      function QueryPerformanceFrequency(out Frequency: Int64): LongBool; external 'QueryPerformanceFrequency@kernel32.dll stdcall';
      function QueryPerformanceCounter(out Counter: Int64): LongBool; external 'QueryPerformanceCounter@kernel32.dll stdcall';

    procedure MarkTime(var Time: Int64);
    var
      Freq: Int64;
    begin
      if QueryPerformanceFrequency(Freq) then
        QueryPerformanceCounter(Time)
      else
        Time := GetTickCount;
    end;

    function TimeFromMark(Mark: Int64): Double;
    var
      Freq, Now: Int64;
    begin
      if QueryPerformanceFrequency(Freq) then
      begin
        QueryPerformanceCounter(Now);
        Result := ((Now - Mark) / Freq) * 1000;
      end
      else
        Result := (GetTickCount - Mark);
    end;


    function MatchCount(Match, Str: string): Integer;
    var
      p: Integer;
    begin
      Result := 0;
      p := Pos(Match, Str);
      while (p > 0) do
      begin
        Inc(Result);
        p := PosEx(Match, Str, p + 1);
      end;
    end;

    (*function WordCount(Str: string): Integer;
    {$IFNDEF SCAR320_UP}
    var
      InWord: Boolean;
      i, l: Integer;
    {$ENDIF}
    begin
    {$IFNDEF SCAR320_UP}
      Result := 0;
      i := 1;
      l := Length(Str);
      while (i <= l) do
      begin
        case Str[i] of
          'a'..'z', 'A'..'Z', '0'..'9':
            InWord := True;
          '_':
            if InWord then
              while (i < l) do
              begin
                Inc(i);
                case Str[i] of
                  //'_': {nothing};
                  'a'..'z', 'A'..'Z', '0'..'9':
                    Break;
                  else if (Str[i] <> '_') then
                    begin
                      Inc(Result);
                      InWord := False;
                      Break;
                    end;
                end;
              end;
          else if InWord then
          begin
            InWord := False;
            Inc(Result);
          end;
        end;
        Inc(i);
      end;
      if InWord then
        Inc(Result);
    {$ELSE}
      Result := Length(GetNumbers(ReplaceRegex(ReplaceRegex(Str, '\W+', ' '), '\w+', '1')));
    {$ENDIF}
    end;  *)


    function WordCount(Str: string): Integer;
    var
      i: Integer;
      s: TStringArray;
    begin
      Result := 0;
      s := Explode(' ', Str);

      for i := High(s) downto 0 do
        if (s[i] <> '') then
          Inc(Result);
    end;

    function AlphaIndexSort(InputString: TStringArray; InputIndex: TIntegerArray; Offset: Integer; CaseInsensitive: Boolean): TIntegerArray;
    var
      i, ii, l: Integer;
      Input_Int: array of Word;

      {
        non AlphaNumeric 0..1, Numberic 2..11, Alpha UP 12..37, Alpha LO 38..63
        //CaseInsensitive: Alpha UP + LO combined -> AaBbCcDd
        CaseInsensitive: LO = UP
      }

      Output_Int: array[0..63] of record
        Index: TIntegerArray;
        Len: Integer;
      end;
      tmp: TIntegerArray;
      c: Char;
      s: string;
    begin
      l := High(InputIndex);
      SetLength(Input_Int, l + 1);
      SetLength(Result, l + 1);
      if (Offset <= 0) then
        Offset := 1;

      for i := l downto 0 do
      begin
        if (Offset > Length(InputString[InputIndex[i]])) then
        begin
          Input_Int[i] := 0;
          Continue;
        end;
        c := InputString[InputIndex[i]][Offset];

        case c of
          'a'..'z':
            if CaseInsensitive then
              Input_Int[i] := ((Ord(c) - {97}85) {shl 1}) {+ 13}
            else
              Input_Int[i] := Ord(c) - 59;
          'A'..'Z':
            if CaseInsensitive then
              Input_Int[i] := ((Ord(c) - {65}53) {shl 1}) {+ 12}
            else
              Input_Int[i] := Ord(c) - 53;
          '0'..'9':
            Input_Int[i] := Ord(c) - 46;
          else
            Input_Int[i] := 1;
        end;
      end;

      for i := l downto 0 do
        with Output_Int[Input_Int[i]] do
        begin
          SetLength(Index, Len + 1);
          Index[Len] := InputIndex[i];
          Len := Len + 1;
        end;

      for i := 0 to 63 do
        with Output_Int[i] do
          if (Len > 1) then
          begin
            if CaseInsensitive then
            begin
              s := UpperCase(TrimOthers(InputString[Index[0]]));
              for ii := Len - 1 downto 1 do
                if (UpperCase(TrimOthers(InputString[Index[ii]])) <> s) then
                  Break;
            end
            else
            begin
              s := TrimOthers(InputString[Index[0]]);
              for ii := Len - 1 downto 1 do
                if (TrimOthers(InputString[Index[ii]]) <> s) then
                  Break;
            end;
            if (ii > 0) then
            begin
              tmp := AlphaIndexSort(InputString, Index, Offset + 1, CaseInsensitive);
              Index := tmp;
            end;
          end;

      l := 0;
      for i := 0 to 63 do
        with Output_Int[i] do
          if (Len > 0) then
            for ii := 0 to Len - 1 do
            begin
              Result[l] := Index[ii];
              l := l + 1;
            end;
    end;

    function StringSort(Input: TStringArray; SortMethod: (smAlpha, smWordCount, smMatchCount); MatchStr: string; CaseInsensitive: Boolean): TStringArray;
    var
      i, ii, l, m: Integer;
      Input_Int: TIntegerArray;
      Output_Int: array of record
        Index: TIntegerArray;
        Len: Integer;
      end;
      tmp: TIntegerArray;
      Match: string;
    begin
      l := High(Input);
      m := 0;
      SetLength(Input_Int, l + 1);
      SetLength(Result, l + 1);

      case SortMethod of
        smAlpha:
          begin
            for i := l downto 0 do
              Input_Int[i] := i;
            Input_Int := AlphaIndexSort(Input, Input_Int, 1, CaseInsensitive);
            for i := l downto 0 do
              Result[i] := Input[Input_Int[i]];
            Exit;
          end;
        smWordCount:
          for i := l downto 0 do
          begin
            Input_Int[i] := WordCount(Input[i]);
            if (Input_Int[i] > m) then
              m := Input_Int[i];
          end;
        smMatchCount:
          begin
            if CaseInsensitive then
              Match := UpperCase(MatchStr)
            else
              Match := MatchStr;
            for i := l downto 0 do
            begin
              if CaseInsensitive then
                Input_Int[i] := MatchCount(Match, UpperCase(Input[i]))
              else
                Input_Int[i] := MatchCount(Match, Input[i]);
              if (Input_Int[i] > m) then
                m := Input_Int[i];
            end;
          end;
        else
          begin
            WriteLn('Invalid SortMethod used in StringSort!');
            Exit;
          end;
      end;

      SetLength(Output_Int, m + 1);

      for i := l downto 0 do
        with Output_Int[Input_Int[i]] do
        begin
          SetLength(Index, Len + 1);
          Index[Len] := i;
          Len := Len + 1;
        end;

      for i := 0 to m do
        with Output_Int[i] do
          if (Len > 1) then
          begin
            Match := UpperCase(TrimOthers(Input[Index[0]]));
            if CaseInsensitive then
            begin
              for ii := Len - 1 downto 1 do
                if (UpperCase(TrimOthers(Input[Index[ii]])) <> Match) then
                  Break;
            end
            else
            begin
              Match := TrimOthers(Input[Index[0]]);
              for ii := Len - 1 downto 1 do
                if (TrimOthers(Input[Index[ii]]) <> Match) then
                  Break;
            end;
            if (ii > 0) then
            begin
              tmp := AlphaIndexSort(Input, Index, 1, CaseInsensitive);
              Index := tmp;
            end;
          end;

      l := 0;
      for i := m downto 0 do
        with Output_Int[i] do
          if (Len > 0) then
            for ii := 0 to Len - 1 do
            begin
              Result[l] := Input[Index[ii]];
              l := l + 1;
            end;
    end;


    var
      s, ss: TStringArray;
      i: Integer;
      t: Int64;
    begin
      //s := ['z', 'y', 'x', 'Z', 'Y', 'X', 'a', 'b', 'c', 'aa', 'aa', 'ab', 'aaaa', 'aaaa', '.abc', '.0123', '=abcdef', '987', '654', '05', '987A', '987.'];
      s := ['say lol 1', 'h^ehehe', 's.ay ONE two three', 'say lol', 'say heho! (not!)', 'Hey', 'Hello', 'Hai', 'Hoi ', 'hello', 'hEY', 'hello', 'Hoi', '.lo l123', '.lol ', '.lol.', '.lolA', '.lola', '.567', '567', '0123', '...lol', 'bye', 'cya', 'zebra', 'ZONK!'];

      MarkTime(t);
      for i := 1 to 50 do
        ss := StringSort(s, smAlpha, 'he', False);
      WriteLn(FloatToStr(TimeFromMark(t) / 50.0)+' ms.');

      ClearReport;
      for i := 0 to High(ss) do
        AddToReport(ss[i]);
    end.

    I believe this was for some competition, but it might be a bit overkill for a school assignment, though. Recursive would indeed be a good way to do it. What the script above does (AlphaIndexSort) is place all strings in an array according to their startletter. If an array for a certain startletter is larger than 1, you'll have to sort that array on the next letter.
    Last edited by nielsie95; 02-10-2010 at 03:00 PM.

  4. #4
    Join Date
    Apr 2008
    Location
    Marquette, MI
    Posts
    15,252
    Mentioned
    138 Post(s)
    Quoted
    680 Post(s)

    Default

    Quote Originally Posted by Nava2 View Post
    Best way to do it would probably be with a recursive algorithm to sort through a single index and move through it that way.

    Not really 100% how to do it, I wish I could help you out more though.
    That's what I was thinking, I was just hoping there was an easier way that I wasn't thinking of. Lol.

    Quote Originally Posted by nielsie95 View Post
    I believe this was for some competition, but it might be a bit overkill for a school assignment, though. Recursive would indeed be a good way to do it. What the script above does (AlphaIndexSort) is place all strings in an array according to their startletter. If an array for a certain startletter is larger than 1, you'll have to sort that array on the next letter.
    Thanks for that, I can't use it exactly because I have to write all the code myself, but at least I have something to refer to if needed. Just looking at it gave me a couple ideas. Hopefully I can make it work.

  5. #5
    Join Date
    Dec 2009
    Posts
    146
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    Find length of string a
    Find length of string b
    Work length is shorter of the two
    Counter = one to work length
    Compare letter (counter) of string a to letter (counter) of string b
    if identical, increment counter and repeat.
    if no match at the end of the counter loop, then the shorter comes first. ("Nothing" comes before "something" when alphabetizing)

    For the third string, you would have to advance through all the already alphabetized strings one at a time and compare them until you found the slot where it fits.

    Hope this helps.

    Sometimes you can just use math operators, I'm not sure if this is possible here. For example you can say
    IF (stringA<stringB) THEN

  6. #6
    Join Date
    Apr 2008
    Location
    Marquette, MI
    Posts
    15,252
    Mentioned
    138 Post(s)
    Quoted
    680 Post(s)

    Default

    Quote Originally Posted by jimthesoundman View Post
    Find length of string a
    Find length of string b
    Work length is shorter of the two
    Counter = one to work length
    Compare letter (counter) of string a to letter (counter) of string b
    if identical, increment counter and repeat.
    if no match at the end of the counter loop, then the shorter comes first. ("Nothing" comes before "something" when alphabetizing)

    For the third string, you would have to advance through all the already alphabetized strings one at a time and compare them until you found the slot where it fits.

    Hope this helps.

    Sometimes you can just use math operators, I'm not sure if this is possible here. For example you can say
    IF (stringA<stringB) THEN
    I have no idea what you mean.

    I've updated the first post with what I have now. It works for the first two letters in the string. I just need help to make it keep checking the next letter if needed.

  7. #7
    Join Date
    Jun 2007
    Location
    Wednesday
    Posts
    2,446
    Mentioned
    3 Post(s)
    Quoted
    1 Post(s)

    Default

    Recursion recursion recursion!

    Simply produce a function like so:

    SCAR Code:
    function: IsBefore(str1, str2: string; p: Integer): Boolean;
    begin
      if (str1[p] = str2[p]) then
        Result := IsBefore(str1, str2, p + 1)
      else
        Result := Ord(str1[p]) < Ord(str2[p]); // You probably want a more comprehensive check here
    end;
    Then voila, you can compare 2 strings of an unknown length (you probably also want a check to make sure you don't go out of string range).
    By reading this signature you agree that mixster is superior to you in each and every way except the bad ways but including the really bad ways.

  8. #8
    Join Date
    Apr 2008
    Location
    Marquette, MI
    Posts
    15,252
    Mentioned
    138 Post(s)
    Quoted
    680 Post(s)

    Default

    Quote Originally Posted by mixster View Post
    Recursion recursion recursion!

    Simply produce a function like so:

    SCAR Code:
    function: IsBefore(str1, str2: string; p: Integer): Boolean;
    begin
      if (str1[p] = str2[p]) then
        Result := IsBefore(str1, str2, p + 1)
      else
        Result := Ord(str1[p]) < Ord(str2[p]); // You probably want a more comprehensive check here
    end;
    Then voila, you can compare 2 strings of an unknown length (you probably also want a check to make sure you don't go out of string range).
    I'm not sure how I could use that though. I've been trying to do this for hours, so I probably just can't think.

  9. #9
    Join Date
    May 2006
    Location
    Amsterdam
    Posts
    3,620
    Mentioned
    5 Post(s)
    Quoted
    0 Post(s)

    Default

    Quote Originally Posted by Coh3n View Post
    I'm not sure how I could use that though. I've been trying to do this for hours, so I probably just can't think.
    Use in combination with quicksort, where the normal ">/<" comparison would be replaced with this (or a similar) function.

    Delphi/FPC has a method (that mixster kinda created), its called "CompareStr" -> http://www.freepascal.org/docs-html/...omparestr.html
    Verrekte Koekwous

  10. #10
    Join Date
    Jun 2007
    Location
    Wednesday
    Posts
    2,446
    Mentioned
    3 Post(s)
    Quoted
    1 Post(s)

    Default

    I believe it should actually work just like that (on a basic level of course). What it does is compare the chars at position p in strings str1 and str2. If they're the same, then it compares the next char, which is at position p + 1. If they're the same, then it compares the next char at p + 2 and so on. If they're not the same, then it returns true if the compared char is a smaller value for str1 (ie str1 comes before str2 in an alphabetic list).
    By reading this signature you agree that mixster is superior to you in each and every way except the bad ways but including the really bad ways.

  11. #11
    Join Date
    Apr 2008
    Location
    Marquette, MI
    Posts
    15,252
    Mentioned
    138 Post(s)
    Quoted
    680 Post(s)

    Default

    Quote Originally Posted by mastaraymond View Post
    Use in combination with quicksort, where the normal ">/<" comparison would be replaced with this (or a similar) function.

    Delphi/FPC has a method (that mixster kinda created), its called "CompareStr" -> http://www.freepascal.org/docs-html/...omparestr.html
    Quote Originally Posted by mixster View Post
    I believe it should actually work just like that (on a basic level of course). What it does is compare the chars at position p in strings str1 and str2. If they're the same, then it compares the next char, which is at position p + 1. If they're the same, then it compares the next char at p + 2 and so on. If they're not the same, then it returns true if the compared char is a smaller value for str1 (ie str1 comes before str2 in an alphabetic list).
    Ohhh okay. I didn't really understand the recursion concept, but that helped a lot.

    Thanks guys, I think I know how I can use this to finish up

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •