QouicSort DESC + polskie znaki

0

Jak posortowac liste nie rosnaco tlyko malejaco przy czym w nazwach sa polskie znaki - teraz pokazuje je dopiero na samym koncu.

  procedure QuickSortStringDesc(iLo, iHi: Integer);
  var Lo, Hi:Integer; Mid:string;
  begin
    Lo:=iLo; Hi:=iHi;
    Mid:=A.Cols[Colu][(Lo+Hi) div 2];
    repeat
      while A.Cols[Colu][Lo]<Mid do Inc(Lo);
      while A.Cols[Colu][Hi]>Mid do Dec(Hi);
      if Lo<=Hi then
       begin Zamien(Lo,Hi); Inc(Lo); Dec(Hi); end;
    until Lo>Hi;
    if Hi>iLo then QuickSortStringDesc(iLo,Hi);
    if Lo<iHi then QuickSortStringDesc(Lo,iHi);
  end;

</delphi>

!!!! :)dRum i ŁF DZIEKI ZA POMOC !!!!!!!!!!!!!!!!!!!!

0

klika tematow nizej:

http://4programmers.net/Forum/viewtopic.php?id=78122

jak na moje to w twoim przypadku rowniez bedzie musiala zostac utworzona tablica z alfabetem polskim na ktorej sortowanie bedzie sie opierac

0

tak widze że temat jest o sortowaniu ale w SQL-u , a teoretycznie że na tablicy to tez wiem :p tylko jak wykonac ?

0

kurde 1:22 juz mi sie nie chce myslec a rano na 8 do szkoly :/ sprobuje napisac ci ten kodzik jeszcze dzisiaj, teraz ide spac, cya

0

3 rzeczy:

  • Sortowanie uwzgledniajace polskie znaki ąęśćńł...
  • Nie-uwzględnianie dużych liter A=a
  • Sortowanie malejące

Z gory dzięki za pomoc

0

Witam, tak jak obiecalem podaje kodzik na sortowanie slow z polskimi znakami w kolejnosci malejacej. Slowa sa zamieszczone w tablicy "Wyrazy", ale zmodyfikowanie procedurki, aby sortowala wyrazy chociazby z jakiegos komponentu nie powinno sprawic problemu. Oka a teraz pora na kodzik:


var
  Form1: TForm1;
  TabAlfabet : array [0 .. 30] of char;
  Wyrazy : array [1..10] of string[20];

implementation

{$R *.dfm}


procedure WypelnijTabAlfabetem;
begin
 TabAlfabet[0] := ' ';
 TabAlfabet[1] := 'a';
 TabAlfabet[2] := 'ą';
 TabAlfabet[3] := 'b';
 TabAlfabet[4] := 'c';
 TabAlfabet[5] := 'ć';
 TabAlfabet[6] := 'd';
 TabAlfabet[7] := 'e';
 TabAlfabet[8] := 'ę';
 TabAlfabet[9] := 'f';
 TabAlfabet[10] := 'g';
 TabAlfabet[11] := 'h';
 TabAlfabet[12] := 'i';
 TabAlfabet[13] := 'j';
 TabAlfabet[14] := 'k';
 TabAlfabet[15] := 'l';
 TabAlfabet[16] := 'ł';
 TabAlfabet[17] := 'm';
 TabAlfabet[18] := 'n';
 TabAlfabet[19] := 'ń';
 TabAlfabet[20] := 'o';
 TabAlfabet[21] := 'ó';
 TabAlfabet[22] := 'p';
 TabAlfabet[23] := 'r';
 TabAlfabet[24] := 'ś';
 TabAlfabet[25] := 't';
 TabAlfabet[26] := 'u';
 TabAlfabet[27] := 'w';
 TabAlfabet[28] := 'y';
 TabAlfabet[29] := 'ź';
 TabAlfabet[30] := 'ż';
end;

procedure WypelnijWyrazy;
begin
 Wyrazy[1] := 'bc';
 Wyrazy[2] := 'ac';
 Wyrazy[3] := 'agb';
 Wyrazy[4] := 'cd';
 Wyrazy[5] := 'def';
 Wyrazy[6] := 'dfg';
 Wyrazy[7] := 'zzzz';
 Wyrazy[8] := 'aaaa';
 Wyrazy[9] := 'wwww';
 Wyrazy[10] := 'mmm';
end;

function WiekszyWyraz1 (slowko1, slowko2 : string): boolean;
var
 a, b, i, wynik : integer;
 koniec : boolean;
begin
  LowerCase(slowko1); //zamien na male litery slowko 1 i 2
  LowerCase(slowko2);
  if slowko1 = slowko2 then    // jezeli slowka sa rowne
   koniec := false
  else
   begin            // jesli slowka nie sa rowne to je zbadaj
     if length(slowko1) > length(slowko2) then
       slowko2 := slowko2 + ' '  // dokleja spacje do krotszego slowka
     else      // jesli beda rowne w znakach to blizej w alfabecie bedzie slowko krotsze...
       slowko1 := slowko1 + ' ';
     wynik := 0;
     i := 1;
      repeat
        a := 0;
        b := 0;
        while slowko1[i] <> TabAlfabet[a] do
          Inc(a);
        while slowko2[i] <> TabAlfabet[b] do
          Inc(b);
        if a > b then wynik := 1     // slowko1 jest dalej w alf. niz slowko 2
        else if a < b then wynik := 2  // slowko 1 jest blizej w alf. niz slowko2
        else Inc(i);
      until wynik <> 0;
     if wynik = 1 then koniec := true
     else if wynik = 2 then koniec := false
   end;
  WiekszyWyraz1 := koniec;
end;

procedure BubbleSortPLText (N : integer);
var
 i, j : integer;
 x : string;
begin
 for i := N - 1 downto 1 do
  for j := 1 to i do
   if WiekszyWyraz1(Wyrazy[j], Wyrazy[j + 1]) = false then
   begin
     x := Wyrazy[j];
     Wyrazy[j] := Wyrazy[j+1];
     Wyrazy[j+1] := x;
   end;
end;


procedure TForm1.FormCreate(Sender: TObject);
var i : integer;
begin
 WypelnijTabAlfabetem;
 WypelnijWyrazy;
 BubbleSortPLText (10); 
 for i := 1 to 10 do
 memo.Items.add ( Wyrazy[i]);
end;

Metoda sortowania chwilowo jest babelkowa, gdyz z metoda QuickSort mam maly problem, mysle ze rozwiaze go jeszcze dzisiaj, ponizej zamieszcze jej kodzik jakby ktos widzial gdzies jakis blad to niech pisze smialo (procedurka niby sortuje, ale tak jakos kosmicznie ):

procedure QuickSortPLText (Lewy, Prawy : integer);
var
 i, j : integer;
 podzial, x : string[20];
begin
 i := Lewy;
 j := Prawy;
 podzial := Wyrazy[(Lewy + Prawy ) div 2];
 repeat
   while WiekszyWyraz1(Wyrazy[i], podzial) = false do
    Inc(i);
   while WiekszyWyraz1(podzial, Wyrazy[j]) = true do
    Dec(j);
   if i <= j then
   begin
    x := Wyrazy [i];
    Wyrazy[i] := Wyrazy[j];
    Wyrazy[j] := x;
    Inc(i);
    Dec(j);
   end;
 until (i > j);
  { i rekurencyjnie wywolaj procedurke sortowania dla obu przedzialow}
 if Lewy < j then QuickSortPLText (Lewy, j);
 if i < Prawy then QuickSortPLText (i, Prawy);
end;
0

chyba was pogięło - to się robi w dwóch linijkach przy użyciu funkcji AnsiCompareText() lub AnsiCompareStr().

procedure QuickSortStringDesc(iLo, iHi: Integer);
  var Lo, Hi:Integer; Mid:string;
  begin
    Lo:=iLo; Hi:=iHi;
    Mid:=A.Cols[Colu][(Lo+Hi) div 2];
    repeat
      while AnsiCompareStr(A.Cols[Colu][Lo],Mid) > 0 do Inc(Lo);
      while AnsiCompareStr(A.Cols[Colu][Hi],Mid) < 0 do Dec(Hi);
      if Lo<=Hi then
       begin Zamien(Lo,Hi); Inc(Lo); Dec(Hi); end;
    until Lo>Hi;
    if Hi>iLo then QuickSortStringDesc(iLo,Hi);
    if Lo<iHi then QuickSortStringDesc(Lo,iHi);
  end;

nie testowane, byc może oba znaczki nierówności muszą być w drugą stronę</delphi>

0

:| i po co ja to pisalem ? :D, ale w sumie moj kodzik tez jest dobry ;]. Dluzszy, chociaz przynamiej zatysfakcja, ze samemu sie cos napisalo a nie skorzystalo z gotowej funkcji ;) ahh ta niewiedza ... :/ , pozdrawiam

1 użytkowników online, w tym zalogowanych: 0, gości: 1