配列の順位付け
解決こんにちは
配列の順位付けを教えて下さい。
配列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;
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;
AAAさん
ありがとうございます。
紹介していただいたコードをコピペしてbutton1,memo1を置いて実行してみたところ
TEN := [50,30,10,100,70,60,20,40,50,30];
setとdynamic arrayには互換性がありませんとエラーです。
unitに欠けてるものがあるのでしょうか。
お使いのDelphiはどのバージョンでしょう？
delphi8です。
まさかのDelphi 8ですか？(XE8ならコンパイルは通る)
面倒ですが、
TEN := [50,30,10,100,70,60,20,40,50,30];
は
TEN[0] := 50;
TEN[1] := 30;
...
TEN[9] := 30;
と置き換えてみてください
バージョンアップ必要ということですね。
ありがとうございます。
古いバージョンであっても↑のように置き換ええるだけです
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]この結果が欲しいんですよね。やっぱりバージョンアップしか道は無いのか？
Delphiのバージョンは関係ないですねぇ
解決になっていますが・・・コムソートで構造体としてソートしたサンプルです。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;
mamさんのコード、手元のDelphi 5でも動きますね。
順位:1 点数:98
順位:2 点数:84
順位:3 点数:48
順位:4 点数:41
順位:5 点数:33
となりました。
ちなみに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
こうなりました。
HFUKUSHI様
ご確認ありがとうございます。
コムソートならそこそこ速くて、ソート対象が100万レコード以上になっても再帰呼び出しではないのでスタックオーバーフローは起こらないので良いかなぁと思いまして。
HFUKUSHIさん。mamさん。ありがとうございます。私の理解不足でお手数かけました。
| ツイート |  |