ピタゴラス数を列挙するには？
解決3≦a＜b≦100を満たすピタゴラス数
（a,b,c,）,(a*a+b*b=c*c)
をすべて出力し、その総数も出力するというプログラムを作成したいのですが、どのようにしたらよいのでしょうか。内容を教えていただけませんでしょうか。
最近、夏休みの宿題っぽい質問が多く見受けられますが、
宿題を成し遂げる意義について、少しはお考え下さい。
まず、基礎数学を勉強し、次にDelphiを勉強する。
最後に自分でコーディングする
答えをインラインアセンブラを利用して記述するなんでどうですかね…
実は答えたい気持ちがいっぱい。
数理アルゴリズムとしては結構いい例題な気がします。
つい最近同じ事を書いたけど、
まず、自分がどんな風に考え、どこで判らないのかを説明しては？
宿題？について教えを請うこと自体は否定しませんが、真摯な姿勢が感じられないと、この手の「課題教えて」っぽい質問にはまともな答えは返ってこない気がします。
諸先輩方の意見に賛成です。
でもやっちゃいました。本能には逆らえません。
感想としては、結構難しかったです。
まだまだ高速化できますが、可読性が悪くなるのでこの辺に留めておきます。
unit Unit1;
interface
uses
Windows, SysUtils, Classes, Controls, Forms, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
function getPythagoras(MaxValue:integer; var count:integer):string;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var str:string;
c:Cardinal;
MaxValue,count:integer;
begin
MaxValue:=100;
c:=GetTickCount;
str:= getPythagoras(MaxValue,count);
c:=GetTickCount - c;
str:= '算定範囲 = ' + inttostr(MaxValue) + #13#10 +
'総数 = ' + inttostr(count) + '個' + #13#10 +
'処理にかかった時間 = ' + inttostr(c) + 'ミリ秒' + #13#10 +
str;
Memo1.Text:=Str;
end;
function TForm1.getPythagoras(MaxValue: integer; var count:integer): string;
// MaxValue:a,bの最大値
// count:総数
var
a,b,c,d,m,n: integer;
cList : array of integer;
function noMuch(index:integer):boolean;
var i:integer;
begin
for i:= 0 to Length(cList)-1 do
if cList[i]=index then
begin
Result:=False;
exit;
end;
SetLength(cList,Length(cList)+1);
cList[Length(cList)-1]:=index;
Result:=True;
end;
begin
n:=0;
repeat
inc(n);
m:=n;
repeat
inc(m);
a:=(m*m-n*n);
b:=(2*m*n) ;
c:=(m*m+n*n);
d:=0;
repeat
inc(d);
if (a*d <= MaxValue) and (b*d <= MaxValue) and
(noMuch(c*d)=True) then
if a<b then
Result:=Result +
inttostr(a*d) +#9+
inttostr(b*d) +#9+
inttostr(c*d) + #13#10
else
Result:=Result +
inttostr(b*d) +#9+
inttostr(a*d) +#9+
inttostr(c*d) + #13#10
until (a*d > MaxValue) or (b*d > MaxValue);
until (a > MaxValue) or (b > MaxValue);
m:=n;
a:=(m*m-n*n);
b:=(2*m*n) ;
until (a > MaxValue) or (b > MaxValue);
count:=Length(cList);
end;
end.
ウリャさん、勢いはわかるけど答えがちがうよ
うーん…
エクセルで検算したけど答えに間違えは無い気がするのですが…
取りこぼしあるのかな？
間違えでは無いですが、
m,nは互いに素で片方が偶数、片方が奇数という判別はしてません。
例えばでよいので
足りない(a,b,c)もしくは間違ってる(a,b,c)を教えてくれませんか？
足りない…
もうひと頑張りします orz
ご指導ありです。
もっとスマートに解きたいですけどもう疲れました。
気合のある方挑戦してみてはいかがでしょうか？
function TForm1.getPythagoras2(MaxValue: integer; var count:integer): string;
// MaxValue:a,bの最大値
// count:総数
var
a,b,c,d,e,m,n: integer;
aList,bList,cList : array of integer;
function noMuch(a,b,c:integer):boolean;
var i:integer;
begin
for i:= 0 to Length(cList)-1 do
if (cList[i]=c) and (aList[i]=a) and (bList[i]=b) then
begin
Result:=False;
exit;
end;
i:= Length(cList);
SetLength(aList,i+1);
SetLength(bList,i+1);
SetLength(cList,i+1);
aList[i]:=a;
bList[i]:=b;
cList[i]:=c;
Result:=True;
end;
begin
n:=0;
repeat
inc(n);
m:=n;
repeat
inc(m);
a:=(m*m-n*n);
b:=(2*m*n) ;
c:=(m*m+n*n);
if a>b then
begin
e:=a; a:=b; b:=e;
end;
d:=0;
repeat
inc(d);
if (a*d <= MaxValue) and (b*d <= MaxValue) and
(noMuch(a*d,b*d,c*d)=True) then
begin
Result:=Result +
//inttostr(m) +#9+
//inttostr(n) +#9+
//inttostr(d) +#9+
inttostr(a*d) +#9+
inttostr(b*d) +#9+
inttostr(c*d) +#13#10;
end
until (a*d > MaxValue) or (b*d > MaxValue);
until (a > MaxValue) or (b > MaxValue);
m:=n;
a:=(m*m-n*n);
b:=(2*m*n) ;
until (a > MaxValue) or (b > MaxValue);
count:=Length(cList);
end;
みなさん、ご回答ありがとうございました。特にウリャさん、プログラムを示していただいて大変参考になりました。
皆さんの指摘どおり、これは提出課題のひとつです。
ただ、自分を始めこの授業の履修者は授業で主に図形描写のプログラミングを学習し、さらにDelphiのプログラミングについて体系だって教えられたわけでもないのに（ごく簡単なfor文、if文程度）、突然高度な数式を扱う試験課題を出されて、かなり困惑している状況でした。自分自身いろいろな本を参照したのですが、なにせ四則演算、数の大小・範囲設定、方程式の解の出力の仕方などを詳しく習ってないため、数学的な知識をうまく生かせなかったのです。
時間的にも急だったので失礼な質問文になってしまいました。ご回答いただいきありがとうございました。
>ただ、自分を始めこの授業の履修者は授業で主に図形描写のプログラミングを学習し、さらにDelphiのプログラミングについて体系だって教えられたわけでもないのに（ごく簡単なfor文、if文程度）、突然高度な数式を扱う試験課題を出されて、かなり困惑している状況でした。
そういう不適切な課題を出されたら
出す人(先生？)に指摘して修正させる方がいいよー。
君がここで教えられたものをそのままコピペして
先生に提出すると、君は不正に成績を稼ぐとともに
その先生自身が"不適切な難しさの課題を提出している"
という間違った行為に気がつかないから、
間違った教育が続く事になるんだ。
そういう事に対してみんなが不愉快感を感じているのかもね。
出遅れ・・
こんなんでどう？
※mathをusese節に追加すること
procedure TForm1.Button1Click(Sender: TObject);
var
count :Integer;
Bf:AnsiString;
a,b :Integer;
c :Double;
begin
{
100以下なら時間もたいしてかららないので、
しらみつぶしに挙げる方がラク。
最大値が増えると指数的に計算量が増えるので注意
}
count := 0;
for a:=3 to 99 do
begin
for b:=a+1 to 100 do
begin
c := sqrt(a*a + b*b);
if abs(c - Trunc(c + 0.5)) < MinDouble then //sqrt(a^2 + b^2) が整数かどうか荒くチェック
begin
if ( Trunc(c + 0.5)*Trunc(c + 0.5) = a*a + b*b) then //再チェック
begin
Bf := Format('a:%3d, b:%3d, c;%3d',[a,b,Trunc(c+0.5)]);
Memo1.Lines.add(Bf);
Inc(count);
Bf := '';
end;
end;
end;
end;
Bf := Format('count:%d',[count]);
Memo1.Lines.add(Bf);
end;
(u^2-v^2)^2 + (2*u*v)^2 = (u^2+v^2)^2
から、u,vを総当りで代入すれば(a,b,c)の組み合わせが全部求められるものと思っていましたが、(a,b,c)の素数倍はこれでは作れないようです。知りませんでした。
（ということは素数を列挙する必要があることになります。）
各要素が数十万まで求めるとなると総当りではかなりしんどくなりますので、一旦素数を列挙してから作っていくことになります。たぶん。
そこまでは求められていないでしょうね。
それから、一度荒くチェックする必要はあまりないですね。
ほとんどが弾かれる上記のケースでは最初に荒く判定し枝狩りにしようと思ってましたが、どうみても「荒くチェック」の部分は無駄です。
あ〜・・
ウリャさんは既にm,nを使っちゃんと全部の解を求められていますね。
かなり恥ずかしい。
リストで重複チェックすれば素数かどうかを気にせず総当りでも可能、ということですね。
（駄レス申し訳ありません）
レス遅れてすみません。
ウリャさん、ウォレスさん、ありがとうございました。
再現してみたところ、63通りの答えがちゃんと出力されました。
一方的なお願いにもかかわらずにレスをいただいたことに感謝します。
＞Fusaさん
多分教官のほうも、生徒がすべての課題を自力で解いてくる事を想定していないと思われます。もし教官が生徒が自力で解いてくるものと思っているなら、相当生徒のことを把握していない教官でしょう。後者のような教官はだいたい採点がいい加減なので別にいいんですが。
失礼な「教えて」型の書き込みをしてしまいすみませんでした。
| ツイート |  |