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.
