配列の順位付け

解決


しろ君  2021-11-23 03:43:58  No: 149939  IP: 192.*.*.*

こんにちは

配列の順位付けを教えて下さい。
配列tenと配列junを使って、配列junに順位を格納して表示させようと思っているのですが、
比較せずうまく表示されません。
以下のようなコードを書いてます。
--------------------------------------------------------------------------
function Get(ten:array of integer;jun:array of integer;N:integer):integer;
var
a,k,f,h:integer;
begin
  //
  for a:=0 to N-1 do begin
    jun[a]:=1;//初期値
  end;
  //
  for k:=0 to N-2 do begin
    f:=k+1;
    for h:=f to N-1 do begin
      if Ten[k]<Ten[h] then begin
        Jun[k]:=Jun[k]+1;
      end else begin
        if Ten[k]>Ten[h] then begin
        Jun[h]:=Jun[h]+1;
       end;
      end;
    end;//
    result:=jun[k];
  end;
end;

編集 削除
AAA  2021-11-23 04:23:23  No: 149940  IP: 192.*.*.*

procedure TForm1.Button1Click(Sender: TObject);
var
    I,J,JJ: Integer;
    IND: array of Integer;  //INDEX
    TEN: array of Integer;  //点数
    JUN: array of Integer;  //順位
    X: Integer;
begin
    SetLength(IND,10);
    SetLength(TEN,10);
    SetLength(JUN,10);
    TEN := [50,30,10,100,70,60,20,40,50,30];
    X := 0;

    //INDEX(元に戻す用)
    for I:= 0 to High(TEN) do
    begin
      IND[I] := I;
    end;

    //SORT(点数でSORT)
    for I := 0 to High(TEN) do
    begin
      for J:=0 to High(TEN) do
      begin
        if I <> J then
        begin
          if TEN[I] > TEN[J] then
          begin
            JJ := TEN[J];
            TEN[J] := TEN[I];
            TEN[I] := JJ;
            JJ := IND[J];
            IND[J] := IND[I];
            IND[I] := JJ;
          end;
        end;
      end;
    end;

    //順位付け
    X := TEN[0];
    J := 1;
    JUN[0] := J;
    JJ := 1;
    for I:= 1 to High(TEN) do
    begin
      if TEN[I] < X then
      begin
        J := J + JJ;
        X := TEN[I];
        JJ := 1;
      end
      else
      begin
        JJ := JJ + 1;
      end;
      JUN[I] := J;
    end;

    //SORT(INDEXでSORTして元に戻す)
    for I := 0 to High(TEN) do
    begin
      for J:=0 to High(TEN) do
      begin
        if I <> J then
        begin
          if IND[I] < IND[J] then
          begin
            JJ := TEN[J];
            TEN[J] := TEN[I];
            TEN[I] := JJ;
            JJ := JUN[J];
            JUN[J] := JUN[I];
            JUN[I] := JJ;
            JJ := IND[J];
            IND[J] := IND[I];
            IND[I] := JJ;
          end;
        end;
      end;
    end;

    Memo1.Clear;
    for I:= 0 to 9 do
    begin
      Memo1.Lines.Add(IntToStr(TEN[I])  + ' ' + IntToStr(JUN[I]) + ' ' + IntToStr(IND[I]));
    end;

end;

編集 削除
しろ君  2021-11-23 10:42:29  No: 149941  IP: 192.*.*.*

AAAさん
ありがとうございます。

紹介していただいたコードをコピペしてbutton1,memo1を置いて実行してみたところ
TEN := [50,30,10,100,70,60,20,40,50,30];
setとdynamic arrayには互換性がありませんとエラーです。
unitに欠けてるものがあるのでしょうか。

編集 削除
HFUKUSHI  2021-11-23 11:58:04  No: 149942  IP: 192.*.*.*

お使いのDelphiはどのバージョンでしょう?

編集 削除
しろ君  2021-11-23 12:35:49  No: 149943  IP: 192.*.*.*

delphi8です。

編集 削除
HFUKUSHI  2021-11-24 02:03:49  No: 149945  IP: 192.*.*.*

まさかのDelphi 8ですか?(XE8ならコンパイルは通る)
面倒ですが、
TEN := [50,30,10,100,70,60,20,40,50,30];

TEN[0] := 50;
TEN[1] := 30;
...
TEN[9] := 30;
と置き換えてみてください

編集 削除
しろ君  2021-11-25 02:14:56  No: 149951  IP: 192.*.*.*

バージョンアップ必要ということですね。
ありがとうございます。

編集 削除
HFUKUSHI  2021-11-25 11:34:51  No: 149952  IP: 192.*.*.*

古いバージョンであっても↑のように置き換ええるだけです

編集 削除
しろ君  2023-03-19 10:20:33  No: 150886  IP: 192.*.*.*

chatgptの登場でDelphi7でソートプログラムをお願いしました。できあがったコードでソートしてみたのですが、やはりバージョンが古いのか思った結果が得られません。
function get3(const ind, ten: array of integer; var jun: array of integer): integer;
var
  i, j, k, n: integer;
  aind, aten, ajun: array of integer;
begin
  n := Length(ind);
  SetLength(aind, n);
  SetLength(aten, n);
  SetLength(ajun, n);

  for i := 0 to n - 1 do
  begin
    aind[i] := ind[i];
    aten[i] := ten[i];
    ajun[i] := jun[i]; // jun を ajun にコピー
  end;

  for i := 0 to n - 2 do
    for j := i + 1 to n - 1 do
      if aten[i] < aten[j] then
      begin
        k := aten[i];
        aten[i] := aten[j];
        aten[j] := k;
        k := aind[i];
        aind[i] := aind[j];
        aind[j] := k;
        k := ajun[i];
        ajun[i] := ajun[j];
        ajun[j] := k;
      end
      else if aten[i] = aten[j] then
      begin
        if ajun[i] > ajun[j] then
        begin
          k := ajun[i];
          ajun[i] := ajun[j];
          ajun[j] := k;
        end;
      end;

  Result := 0;
  for i := 1 to n do
  begin
    if aind[i - 1] = 0 then
      Continue;
    if (i > 1) and (aten[i - 1] = aten[i - 2]) then
    begin
      for k := i-2 downto 0 do
      begin
        if (aten[k] > aten[i-1]) or ((aten[k] = aten[i-1]) and (ajun[k] < ajun[i-1])) then
        begin
          jun[aind[i - 1]] := jun[aind[k]];
          Break;
        end;
      end;
    end
    else
      jun[aind[i - 1]] := i;
  end;
  // 最大順位を返す
  Result := jun[1];
  for i := 2 to n do
    if jun[i] > Result then
      Result := jun[i];
end;
データ表示を確認すると
ind:=[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16]
Ten := [33, 40, 23, 35, 35, 50, 32, 32, 0, 31, 24, 38, 30, 35, 42, 37];
jun:= [1, 2, 1, 4, 2, 3, 1, 6, 7, 1, 9, 11, 4, 12, 6, 3];
やはりjun[i]だけ数値が違います。jun=[7,10,1,9,11,2,13,6,8,3,12,4,15,14,5,16]この結果が欲しいんですよね。やっぱりバージョンアップしか道は無いのか?

編集 削除
HFUKUSHI  2023-03-20 01:25:33  No: 150887  IP: 192.*.*.*

Delphiのバージョンは関係ないですねぇ

編集 削除
mam  URL  2023-03-20 05:05:17  No: 150888  IP: 192.*.*.*

解決になっていますが・・・コムソートで構造体としてソートしたサンプルです。Delphi8で動くのかどうかですが。
コムソートの参考
https://mam-mam.net/delphi/comb_sort.html

type
    TJt=record
    jun:integer;
    ten:integer;
  end;

implementation

{$R *.dfm}

uses Math;

//コムソート
procedure CombSort(var a:array of TJt);
  //二つのTJt構造体の値を入れ替える
  procedure SwapTJt(var v1,v2:TJt);
  var sw:TJt;
  begin
    sw:=v1;
    v1:=v2;
    v2:=sw;
  end;
var between:Integer;//間隔
    i,l,h:integer;
begin
  l:=Low(a);
  h:=High(a);
  //初期の比較間隔
  between:=Math.Floor((h-l+1)/1.3);
  while between>0 do //比較間隔が0になったら終了
  begin
    i:=l;
    while h>=(i+between) do
    begin
      if (a[i].ten<a[i+between].ten) then
        SwapTJt(a[i],a[i+between]);
      inc(i);
    end;
    //比較間隔を小さくする(1.3で割って切り捨て)
    between:=Math.Floor(between/1.3);
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var jt:array of TJt;
    i:Integer;
begin
  SetLength(jt,5);
  jt[0].ten:=41;  //HFUKUSHI様のご指摘箇所
  jt[1].ten:=84;  //HFUKUSHI様のご指摘箇所
  jt[2].ten:=48;  //HFUKUSHI様のご指摘箇所
  jt[3].ten:=98;  //HFUKUSHI様のご指摘箇所
  jt[4].ten:=33;  //HFUKUSHI様のご指摘箇所

  CombSort(jt);
  for i := Low(jt) to High(jt) do
    jt[i].jun:=i+1;

  for i := Low(jt) to High(jt) do
    Memo1.Lines.Add(
      Format('順位:%d 点数:%d',[jt[i].jun,jt[i].ten])
    );
end;

編集 削除
HFUKUSHI  2023-03-20 07:36:00  No: 150889  IP: 192.*.*.*

mamさんのコード、手元のDelphi 5でも動きますね。
順位:1 点数:98
順位:2 点数:84
順位:3 点数:48
順位:4 点数:41
順位:5 点数:33
となりました。

編集 削除
HFUKUSHI  2023-03-20 07:41:20  No: 150890  IP: 192.*.*.*

ちなみにAAAさんのコードもTEN := [50,30,10,100,70,60,20,40,50,30];の部分を置き換えただけで動きますね
50 4 0
30 7 1
10 10 2
100 1 3
70 2 4
60 3 5
20 9 6
40 6 7
50 4 8
30 7 9
こうなりました。

編集 削除
mam  2023-03-20 07:42:45  No: 150891  IP: 192.*.*.*

HFUKUSHI様

ご確認ありがとうございます。
コムソートならそこそこ速くて、ソート対象が100万レコード以上になっても再帰呼び出しではないのでスタックオーバーフローは起こらないので良いかなぁと思いまして。

編集 削除
しろ君  2023-03-20 11:41:28  No: 150892  IP: 192.*.*.*

HFUKUSHIさん。mamさん。ありがとうございます。私の理解不足でお手数かけました。

編集 削除