begin if a < b then begin tmp := b ; b := a; a := tmp; end; repeat tmp := b; b := a mod b ; a := tmp ; until b = 0 ; gcd := a; end { gcd };
88 名前：86 [2006/01/28(土) 23:23:29 ]
87のつづき
begin n:=1; repeat writeln('整数値を入力してください。(',n:2,'回目)'); readln(q); if (q > 0 ) then begin if ( n = 1 ) then p:=q else p:=gcd(p,q); n:=n+1; end; until ( n > 10 ) or ( q = 0 ); writeln('最大公約数は',p,'です。') ; end.
89 名前：774RR mailto:sage [2006/01/28(土) 23:23:43 ]
Program fibonacci(input,output); var i,n : integer;
function fibonacci(n : integer):integer; begin if n>=3 then fibonacci:=fibonacci(n-1)+fibonacci(n-2) else fibonacci:=1 end; { fibonacci }
begin writeln('数列の長さを入力してください'); readln(n); for i:=1 to n do write(fibonacci(i):3,', '); writeln end.
function gcd(a, b: integer): integer; begin if b = 0 then gcd := a else gcd := gcd(b, a mod b) end;
92 名前：86 [2006/01/28(土) 23:54:02 ]
program gcd(input, output);
var i,x,answer : integer;
function gcd(a,b : integer):integer;
begin if b=0 then gcd:=a else gcd:=gcd(b,a mod b) end; { gcd }
begin i:=1; repeat writeln(i:2,'番目の値を入力'); readln(x); if x>0 then begin if i=1 then answer:=x else begin answer:=gcd(answer,x); i:=i+1 end; end; until (i>10) or (x=0); writeln('最大公約数は',answer:3); end.
>>95 超適当だけど program f(input, output); var v: Integer; procedure writeOne(d: Integer); begin case d of 0: begin end; 1: write('one'); 2: write('two'); 3: write('three'); 4: write('four'); 5: write('five'); 6: write('six'); 7: write('seven'); 8: write('eight'); 9: write('nine'); 10: write('ten'); 11: write('eleven'); 12: write('twelve'); 13: write('thirteen'); 14: write('fourteen'); 15: write('fifteen'); 16: write('sixteen'); 17: write('seventeen'); 18: write('eighteen'); 19: write('nineteen'); end; end; begin readln(v); if v=0 then write('zero'); if v>=100 then begin writeOne(v div 100); write(' hundred '); v := v mod 100; end; if v>=20 then begin case v div 10 of 2: write('twenty '); 3: write('thirty '); 4: write('forty '); 5: write('fifty '); 6: write('sixty '); 7: write('seventy '); 8: write('eighty '); 9: write('ninety '); end; v := v mod 10; end; writeOne(v); writeln; end.
var i,x,answer : integer; function gcd(a,b : integer):integer; begin if b=0 then gcd:=a else gcd:=gcd(b,a mod b) end; { gcd }
begin i:=1; repeat writeln(i:2,'番目の値を入力'); readln(x); if x>0 then begin if i=1 then answer:=x else answer:=gcd(answer,x); i:=i+1 end; until (i>10) or (x=0); writeln('最大公約数は',answer:3); readln; end.
program k(input,output); var count,x,i : integer; data : array[1..100]of integer; procedure swap(a,b : integer); var tmp : integer; begin readln(a,b); if a<b then begin tmp:=a; a:=b; b:=tmp end; end; { swap }
106 名前：デフォルトの名無しさん [2006/02/05(日) 02:11:20 ]
105つづき
begin count:=0; readln(x); while x<>0 do begin count:=count+1; data[count]:=x; for i:=(count-1) downto 1 do begin swap(data[i],data[i+1]) end; readln(x); end; for i:=1 to count do begin writeln(data[i]) end; end.
５次元のベクトル A と B のデータを読み込み、それらの和ベクトル C とそれらの内積の値 D を求めて出力するプログラムを作れ。 ベクトルの要素のデータ型は、整数、実数のどちらかに統一しなさい。データはキーボードから読み込むものとする。また、 writeln を用いて、データの型、入力のさせ方をメッセージの形で記述せよ。
Program Enjoy2chCalc; const MaxNplus1 = 5; MaxN = 4; type pstack = ^stackitem; stackitem = record data : real; next : pstack end; var stack : pstack; s : string; r : real; i : longint; toend : boolean;
procedure push(r : real); var s : pstack; begin new(s); s^.data := r; s^.next := stack; stack := s end;
procedure pop(var r : real); var s : pstack; begin if stack <> nil then begin s := stack; r := s^.data; stack := s^.next; dispose(s) end else writeln('Stack underrun.') end;
begin initstack; toend := false; repeat disp; write('ENTER Number, +-*/, q-quit, c-clear, a-AC : '); readln(s); if (length(s) = 1) and (s[1] in ['+','-','*','/','q','c','a']) then case s[1] of '+','-','*','/' : calc(s[1]); 'c' : pop(r); 'a' : allclear; 'q' : toend := true end else begin val(s, r, i); push(r) end until toend; allclear; dispose(stack) end.
procedure change; var p,n:integer; previous,temp,next:list; begin n:=1; write('入れ替える位置を指定しなさい'); readln(p); current:=init; while current^.pointer <> nil do begin previous:=current; current:=current^.pointer; next:=current^.pointer; n:=n+1; if n=p then begin temp:=next^.pointer; previous^.pointer:=next; next^.pointer:=current; current^.pointer:=temp end; end; current:=init; while current^.pointer <> nil do begin write(current^.name,' ',current^.id,' '); current:=current^.pointer end; writeln end;
手続きを仕えってなら、こんなのはどうだ? Program Enjoy2chList; type plist = ^listitem; listitem = record data : string; next : plist end; var top, tail : plist; s : string; toend : boolean;
procedure addtolist(s : string); var p : plist; begin new(p); p^.data := s; p^.next := top^.next; top^.next := p end;
procedure exchange(pprev : plist); var pnext, ptemp : plist; begin if pprev<>nil then begin ptemp := pprev^.next; pnext := ptemp^.next; if pnext <> tail then begin ptemp^.next := pnext^.next; pnext^.next := ptemp; pprev^.next := pnext end else writeln('The item is at the tail of the list...') end end;
function findprev(key : string) : plist; var p : plist; begin tail^.data := key; p := top; while p^.next^.data <> key do p := p^.next; if p^.next <> tail then findprev := p else begin writeln(key, ' is not found ... Orz'); findprev := nil end end;
procedure disp; var p : plist; i : integer; begin p := top^.next; i := 0; while p<>tail do begin i := succ(i); writeln(i, ' ', p^.data); p := p^.next end end;
begin initlist; toend := false; repeat write('ENTER Any word to add or NULL to quit: '); readln(s); if s='' then toend := true else begin addtolist(s); disp end until toend; toend := false; repeat write('ENTER Any word to exchange or NULL to quit: '); readln(s); if s='' then toend := true else begin exchange(findprev(s)); disp end until toend; disposelist end.
まず、基本的な型宣言から var SPACE:array[1..maxlegth] of record element:elementtype; next:integer end
elementtypeって何？って感じです・・・。
次にセルを移動するmove関数 function move(var p,q:integer):boolean; var temp:integer; begin if p=0 then begin writeln('セルがない'); return(false) {retuenってなに？} end else begin temp:=q; q:=p; p:=SPACE[q].next:=temp; retuen(true) end end;
手続きINSERT procedure INSERT(x:elementtype;p:position;var L:LIST); begin if p=0 then begin{最初の位置に挿入} if move(available,L) then SPACE[L].element:=x end else{最初以外の位置に挿入} if move(available,SPACE[p].next)then {xのセルをSPACE[p].nextがさしている} SPACE[SPACE[p].next].element:=x end;{INSERT}
次に手続きDELETE procedure DELETE(p:position;var L:LIST); begin if p=0 then move(L,available) else move(SPACE[p].next,available) end;{DELETE}
最後に手続きinitialize procedure initialize; var i:integer; begin for i:=mazsize-1 downto 1 do SPACE[i].next:=i+1; available:=1; SPACE[maxsize].next:=0 end;{inisialize}
