>>228 program test1(input); var o,e : file of integer; i:integer;begin Assign(o,'oddsequence');Rewrite(o); Read(i);while i <> 0 do begin Write(o,i); Read(i); end; Assign(e,'evensequence');Rewrite(e); Read(i);while i <> 0 do begin Write(e,i); Read(i); end; Close(o);Close(e);end.
program test2(output); var o,e,s : file of integer; i,j:integer;begin Assign(o,'oddsequence');Reset(o); Assign(e,'evensequence');Reset(e); Assign(s,'sequence');Rewrite(s);i := 0; j := 0; while not (eof(o) and eof(e) and (i = 0) and (j = 0)) do begin if not eof(o) and (i = 0) then Read(o,i); if not eof(e) and (j = 0) then Read(e,j); if (i <> 0) and (i < j) then begin Write(s,i); i := 0; end else if j <> 0 then begin Write(s,j); j := 0; end; end; Reset(s); while not eof(s) do begin Read(s,i);Write(i);Write(' '); end;Close(o);Close(e);Close(s);end.
フィボナッチ数列の項は、その直前の連続する二つの項の和である。 f( n ) = f( n - 1 ) + f( n - 2 ) 但し、 f(0) = 0, f(1) = 1 である。 フィボナッチ数列の連続する項の差の比 z = { f( n - 1 ) - f( n - 2 ) }/ { f( n ) - f( n - 1 ) } は、 n が大きくなれば、ある値に収束する。この値の近似値を求める プログラムを書き、その値を示せ。この値は黄金分割比と呼ばれる。 フィボナッチ数列は関数 fibonacci を作って求め、項は配列に表せ。まず 30 項まで求め、黄金分割比の値が収束していく様子を出力して 確かめよ。収束判定のために定数 dif = 1.0 e -6 を宣言し、 連続する z の差の絶対値が dif 以下になったとき、 収束したとして計算を終了するプログラムを作り、プログラムとその 計算結果を提出せよ
235 名前：デフォルトの名無しさん [2006/04/24(月) 05:34:47 ]
コンパイルはできるんだけど、何かがおかしいです。 すみませんがわかる方教えてくれませんか？
program pe1_2(input,output); const dif = 1.0e-6; var i,m, g : integer; f, z,q : array [0..500] of real; function fibonacci(n: integer):integer; begin if (n >=0) and (n <=1) then fibonacci:=n else fibonacci:=fibonacci(n-1)+fibonacci(n-2); end; { fibonacci } begin f[i]:=fibonacci(i); writeln('30項まで求めます '); for i :=1 to 30 do begin writeln('f(',i:2,')=',f[i]:1); end; write('m='); readln(m); for i:= 3 to m do repeat z[i]:=(f[i-1]-f[i-2])/(f[i]-f[i-1]); until dif >= z[i]-z[i-1]; writeln(z[i]); {writeln('z(',i:3,')=',z[i]:1,','); } end.
236 名前：デフォルトの名無しさん [2006/04/24(月) 06:10:31 ]
こんな感じじゃないのか？
program pe1_2(input,output); const dif = 1.0e-6; var i : integer; f,z : array [1..30] of real;
function fibonacci(n: integer):integer; begin if (n >=0) and (n <=1) then fibonacci:=n else fibonacci:=fibonacci(n-1)+fibonacci(n-2); end; { fibonacci }
begin writeln('30項まで求めます'); for i :=1 to 30 do begin f[i]:=fibonacci(i); writeln('f(',i:2,')=',f[i]:1); end;
for i:= 3 to 30 do begin z[i]:=(f[i-1]-f[i-2])/(f[i]-f[i-1]); writeln('z(',i:2,')=',z[i]); if (i > 3) and (dif >= abs(z[i]-z[i-1])) then break; end; end.
function fibonacci(n: real):real; begin if (n >=0) and (n <=1) then fibonacci:=1 else fibonacci:=fibonacci(n-1)+fibonacci(n-2); end; { fibonacci }
begin writeln('30項まで求めます'); for i :=1 to 30 do begin f[i]:=fibonacci(i); writeln('f(',i:2,')=',f[i]:10:0); end;
for i:= 3 to 30 do begin z[i]:=(f[i-1]-f[i-2])/(f[i]-f[i-1]); writeln('z(',i:2,')=',z[i]); if (i > 3) and (dif >= abs(z[i]-z[i-1])) then break; end; end.
{構造体の定義} type TData=record c:char;a:Integer;next:Pointer;end; type PData=^TData; var root:PData;
{リストの印刷} procedure writes; var p:PData; begin p:=root; while p<>nil do begin if p^.a>0 then write('+'); write(p^.a,p^.c); p:=p^.next; end; writeln; end;
procedure func(s:string); var w:TData; var p:PData; var sgn:-1..1; var num:string; begin sgn:=1; w.next:=nil; num:=''; while s<>'' do begin w.c:=s[1]; delete(s,1,1); case w.c of '+': begin sgn:= 1;num:=''; end; '-': begin sgn:=-1;num:=''; end; '0'..'9': begin num:=num+w.c; end; 'a'..'z','A'..'Z': begin if num<>'' then w.a:=sgn*StrToInt(num) else w.a:=sgn; p:=root; while p<>nil do begin if p^.c=w.c then begin p^.a:=p^.a+w.a; break; end; p:=p^.next; end; if p=nil then begin w.next:=root; root:=@w; func(s); exit; end; end; '.': writes; end; end; writes; readln(s); if s<>'' then func(s); {続けて処理するなら} end;
エラトステネスの篩の概念は、次のようになります。 1 2 3 4 5 6 7 8 9 10 11 12 13 ... このような数値列を用意して まず最初の2は素数としてチェックして 2の倍数は素数じゃないから、フラグを立てます。 1 2 3 4 5 6 7 8 9 10 11 12 13 ... O X X X X X 次に素数の可能性のある3は素数としてチェックして、 3の倍数はやはり素数じゃないから、フラグを立てます 1 2 3 4 5 6 7 8 9 10 11 12 13 ... O X X X X X O X X X 4にはすでに×がついているので、素数ではなく 次に素数だと思われる5は素数としてチェック。 5の倍数は素数ではないフラグを立てて… 1 2 3 4 5 6 7 8 9 10 11 12 13 ... O X X X X X O X X X O X と続けていくとチェックされていない所に 〇がつき、素数列が求まるという手法です。
type tree = ^node; node = record moji : char; kaisu : integer; left , right : tree; end;
var p , head : tree; a : char;
procedure append(var t : tree; x : char );
begin if t = nil then begin new( t ); t^.moji := x; t^.kaisu := 1; t^.left := nil; t^.right := nil end else if t^.moji = x then t^.kaisu := t^.kaisu + 1 else if ord( t^.moji ) > ord( x ) then append( t^.left , x ) else append( t^.right , x ) end; { append }
270 名前：269 mailto:sage [2006/05/20(土) 16:28:56 ]
procedure printl(t : tree ); begin if t <> nil then begin writeln( t^.moji , t^.kaisu ); printl( t^.left ); end end; { printl } procedure printr(t : tree ); begin if t <> nil then begin writeln( t^.moji , t^.kaisu ); printr( t^.right ); end end; { printr } begin new( head ); new( p ); head := nil; p := head; repeat write( '文字： '); readln( a ); append( p , a ) until a = '.'; printl( head ); write( p^.moji , p^.kaisu ); printr( head ); dispose( head ); dispose( p ) end.
271 名前：269 mailto:sage [2006/05/20(土) 16:35:39 ]
キーボードから「整数」を読込み、 入力データを２分探索木に書込め。 書き込んだ結果を出力せよ。 なお、整数は正または負のデータとし、入力の終了は '０' (ゼロ) で 示すものとする。同じ値が入力されることはないものとせよ。 を program kadai5no2( input , output ); type tree = ^node; node = record kazu : integer; left , right : tree; end; var p , root : tree; a : integer; procedure data(var t : tree; x : integer ); begin if t = nil then begin new( t ); t^.kazu := x; t^.left := nil; t^.right := nil end else if t^.kazu > x then data( t^.left , x ) else data( t^.right , x ) end; { data } procedure printl(t : tree ); begin if t <> nil then begin if t^.right <> nil then begin write( t^.right ); printl( t^.right ) end else begin write( t^.kazu ); printl( t^.left ) end end end; { print }
272 名前：269 mailto:sage [2006/05/20(土) 16:36:48 ]
begin new( root ); new( p ); root := nil; p := root; repeat write( ' 数： '); readln( a ); data( p , a); until a = 0; printl( p ); dispose( p ); dispose( root ) end. としたのですがどちらも出力をどうすればいいか分かりません。出力の他にも変なところがあれば指摘してくれると嬉しいです。
program database( input , output ); type a = ^b ; b = record c : packed array [1..20] of char ; d : a ; var e, f : packed array [1..20] of char ; bagin readln(e); readln(f); if e < f then begin writeln( e , f ); end else begin writeln( f , e ); end; end.
