var i,n: integer; f,z: array [0..1000] of integer;
function fibonacci(n : integer):integer;
begin case n of 3..1000 : fibonacci:=fibonacci(n-1)+fibonacci(n-2); 1,2 : fibonacci:=1; 0 : fibonacci:=0 end; { case } end;
begin write('n='); readln(n); for i:=0 to n do begin f[i]:=fibonacci(i); z[i]:=(f[n-1]-f[n-2])div(f[n]-f[n-1]); writeln('f(',i:2,')=',f[i]:1,', '); writeln(); writeln('z(',i:2,')=',z[i]:1,', '); end; end.
というのを作ったのですが、コンパイルはできるのに値を入力しても答えが出力されませんorz
194 名前：188 [2006/04/12(水) 15:20:31 ]
program Toi3(input,output);
var i,n: integer; f,z: array [0..1000] of integer;
function fibonacci(n : integer):integer;
begin case n of 3..1000 : fibonacci:=fibonacci(n-1)+fibonacci(n-2); 1,2 : fibonacci:=1; 0 : fibonacci:=0 end; { case } end;
begin write('n='); readln(n); for i:=0 to n do begin f[i]:=fibonacci(i); z[i]:=(f[n-1]-f[n-2])div(f[n]-f[n-1]); writeln('f(',i:2,')=',f[i]:1,', '); writeln(); writeln('z(',i:2,')=',z[i]:1,', '); end; end.
if n >= 2 then begin ●; end else begin case n of 0 : ■; 1 : ▲; end; じゃダメなのか？
211 名前：188 [2006/04/14(金) 17:06:52 ]
フィボナッチを以下のように書き換えたのですが、確かに走るし100項でもすぐ出るんですが、マイナスの値がでてくるんです。なぜでしょうか？ program kadai14_2(input,output); var m,k : integer; function fibonacci(n : integer):integer; function fib(i,old,new : integer):integer; begin if i=n then fib:=new else fib:=fib(i+1,new,old+new) end; { fib }
begin if n<=1 then fibonacci:=n else fibonacci:=fib(1,0,1) end; { fibonacci }
begin writeln('数列の長さを入力してください'); readln(m); for k:=1 to m do begin write(fibonacci(k):1); write(',') end; writeln; end.
文字列＋整数型の加算の例 function AddN(s:string;N:Integer):string; var i,M:Integer; var r:string; procedure afunc; begin M:=((N mod 10)+10) mod 10; r:=Char( ord('0') +M)+r; N:=N-M; N:=N div 10; end; begin r:=''; for i := length(s) downto 1 do begin N:=N+StrToInt(s[i]); afunc; end; while N<>0 do begin M:=((N mod 10)+10) mod 10; afunc; end; Result:=r; end; 文字列同士は、ループが３つ必要
function AddAB(a,b:string):string; var i,j,N,M:Integer; var r:string; procedure afunc; begin M:=((N mod 10)+10) mod 10; r:=Char( ord('0') +M)+r; N:=N-M; N:=N div 10; end; begin r:=''; j:=length(b); N:=0; for i := length(a) downto 1 do begin N:=N+StrToInt(a[i]); if j>=1 then N:=N+StrToInt(b[j]); afunc; dec(j); end; for i := j downto 1 do begin N:=N+StrToInt(b[i]); afunc; end; while N<>0 do begin M:=((N mod 10)+10) mod 10; afunc; end; Result:=r; end;
function fibonacci(n : string):string; function fib(i,old,new : string):string; begin if i=n then fib:=new else fib:=fib(AddN(i,1),new,AddAB(old,new)) end; { fib }
begin if (length(n)<2) and(StrToInt(n)<=1) then fibonacci:=n else fibonacci:=fib('1','0','1') end; { fibonacci }
begin for k := 1 to 100 do writeLn(k:5,':', fibonacci(IntToStr(k))) ;
program kadai21(input , output , opfile); type Kojindate = record name : packed array [1..10] of char; tel : packed array [1..15] of char; end; var opfile : file of Kojindate; a : Kojindate; begin repeat rewrite( opfile , 'intdate' ); writeln('名前：'); readln( a.name ); writeln('電話番号'); readln( a.tel); write(opfile , a); until a.name = 'end'; reset ( opfile , 'intdate' ); while not eof(opfile) do begin repeat read( opfile , a ); writeln( '名前：',a.name , '電話番号：' , a.tel); until a.name = 'end' end end.
>>227 procedure search; var name : packed array [1..10] of char; c : boolean; begin Readln(name); while name <> 'end' do begin Reset(opfile); c := true; while not eof(opfile) do begin Read(opfile, a); if a.name = name then begin Writeln(a.tel); c := false; end; end; Close(opfile); if c then Writeln('該当者なし'); Readln(name); end; end; { search }
>>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.
