program Keisan(input,output); var a,b,wa:integer; begin a:=30; writeln('数字を入力してください'); readln(b); wa:=a+b; writeln('a=',a,' b=',b); writeln('a+b=',wa) end.
function FindMax(A: array of Integer; Start: Integer): Integer; var Max, I: Integer; begin Max := Start; for I := Start + 1 to High(A) do if A[I] > A[Max] then Max := I; FindMax := Max; end;
procedure Swap(var A, B: Integer); var Temp: Integer; begin Temp := A; A := B; B := Temp; end;
procedure Sort(var A: array of Integer); var I: Integer; begin for I := 0 to High(A) do Swap(A[I], A[FindMax(A, I)]); end;
再帰的な定義をそのまま実装（普通は末尾再帰→繰り返しにする）するか、 a ^ bのbが実数の場合は標準函数（だったよね）としてlnとexpがあることを利用すると、ln(a^b) = ln(a) * bだから a^b = exp(ln(a) * b)
冪乗の演算子／函数がないのに対数、指数関数があるというのがWirth先生。 以下FPCでテスト墨
Program PowerTest; var a, b : real;
function power(a : real; b : integer) : real; begin if b > 0 then power := a * power(a, pred(b)) else if b = 0 then power := 1 else power := 1 / power(a, -b) end;
function RealPower(a, b : real) : real; begin RealPower := exp(ln(a) * b) end;
program sort(input,putput); const numofdata=893; var d: array [1..numofdata] of integer; i,j,k: integer; tmp: integer; begin for i:=1 to numofdata do begin read(d[i]); end;
for i:=1 to numofdata-1 do begin j:=i; for k:=i+1 to numofdata do begin if d[j]>d[k] then j:=k; end; tmp:=d[j]; d[j]:=d[i]; d[i]:=tmp; end;
for i:=1 to numofdata do begin writeln(d[i]) end end.
Program sort(input, output); (* putputってぉぃw *) const numofdata = 893; (* 嗤いどころかこれ。これを10000に汁 *) type dataindex = 1..numofdata; var d: array [dataindex] of integer; datanum : dataindex; (* データ数を貯めとく変数を用意するのが肝な *) i, j, k: integer; tmp: integer; begin write('n (max ', numofdata, ')= '); readln(datanum); for i := 1 to datanum do read(d[i]); (* begin endブロックいらね *) for i := 1 to pred(datanum) do begin j := i; for k := succ(i) to datanum do if d[j] > d[k] then j := k; tmp := d[j]; d[j] := d[i]; d[i] := tmp (* セミコロンいらね *) end; for i := 1 to datanum do writeln(d[i]); writeln('...so modified and tested by 2channelers ;-)') (* このまま提出するなよ *) end.
問１を自分なりにやってみたのですが、 program gengou(input,output); var a:integer; begin readln(a); writeln('西暦',a,'年の元号は？'); if a>1988 then writeln('平成',a-1988,'年です') else if a>1926 then writeln('昭和',a-1926,'年です') else if a>1910 then writeln('大正',a-1910,'年です') else if a>1867 then writeln('明治',a-1867,'年です') else writeln('江戸時代です') end.
var a, i: integer; const era: array[0..3] of Integer = (1989, 1926, 1912, 1868); eraname: array[0..3] of array[0..10] of char = ('平成', '昭和', '明治', '大正'); begin readln(a); writeln('西暦', a, '年の元号は：'); for i := 0 to 3 do if a >= era[i] then begin writeln(eraname[i], a - era[i] + 1, '年'); if a = era[i] then writeln(eraname[i + 1], a - era[i + 1] + 1, '年'); break end
break文もBorland方言だな。標準Pならgoto文で抜け出すことになるね（こういう時のためにgotoを残してあるんで）。 era回りだけど、record型を使う方が原則的で美しいよな。それと、効率は少し落ちるけど、 eraname = packed array [1..10] of char; era = record beginyear, endyear : integer; name ; eraname end; eraarray = array[1..4] of era;
とやってあげて、eをeraarray型の変数として、 for i := 1 to 4 do with e[i] do begin if (a >= beginyear) and (a <= endyear) then begin j := a - beginyear; if j = 0 then write(name, '元年 ') else write(name, succ(j), '年 ') end end; writeln
program test (input,output,IntFile); type tree=^node; node=record name:char; tel:integer; left,right:tree; end; var IntFile:file of tree; r:tree; begin reset(IntFile,'tel-data'); read(IntFile,r);
program sort(input,output); var d:array [1..10000] of integer; numofdata:integer; i,j,k:integer; tmp:integer; begin read(numofdata) for i:=1 to numofdata do begin read(d[i]); end; ↓続きます
ちょいと書き直すと、 Program sort(input,output); var d:array [1..10000] of integer; numofdata:integer; i,j,k:integer; tmp:integer; begin read(numofdata); for i:=1 to numofdata do read(d[i]); (* begin end いらね *) for i:=1 to numofdata-1 do begin j:=i; for k:=i+1 to numofdata do if d[j]>d[k] then j:=k; (* begin end いらね *) tmp:=d[j]; d[j]:=d[i]; d[i]:=tmp end;
for i:=1 to numofdata do writeln(d[i]) (* begin end いらね *) end.
procedure binarysearch(p : データの型; mini, maxi : integer); begin i := (mini + maxi) div 2; (* mini と maxi の間の数ならなんでも *) if p = d[i] then writeln('Found at ', i) else if maxi = mini then begin write('Not found. Must be inserted '); if p > d[i] then write('after ') else write('before '); writeln(i, ' th number.') end else if p > d[i] then binarysearch(p, succ(i), maxi) else binarysearch(p, mini, pred(i)) end;
procedure insert(p ; データの型; i : integer); var j : integer; begin numofdata ;= succ(numofdata); for j := numofdata downto succ(i) do d[j] := d[pred(j)]; (* >>530は間違いだ orz *) d[i] := p end;
これは p を d の i 番目にそうぬうする手続な。>>531の真ん中へんでこれを呼ぶ。 if maxi = mini then begin i := i + ord(p > d[i]); writeln('Not found, then instert it as ', i, ' th number.'); insert(p, i) end
めんどいから逆ポで式を書くことにする。 例えば a b & c ¥ | ならば (a and b) or (not c) な。変数の個数は maxvar で与える。 Program Viva2chan; const maxvar = 'c'; type pnode= ^node; node = record value : boolean; next : pnode end; var stack : pnode; variables : array ['a'..maxvar] of boolean; i : integer; s : string; c : char;
procedure push(v : boolean); var nd : pnode; begin new(nd); nd^.value := v; nd^.next := stack; stack := nd end;
function pop : boolean; var v : boolean; nd : pnode; begin nd := stack; v := nd^.value; stack := nd^.next; pop := v; dispose(nd) end;
procedure ope(operation : char); var operand : boolean; begin if operation in ['&', '|', '#'] then operand := pop; with stack^ do case operation of '&' : value := value and operand; '|' : value := value or operand; '#' : value := value xor operand; '¥' : value := not value end end;
function calc(source : string) : boolean; var i : integer; c : char; begin for i := 1 to length(source) do begin c := source[i]; if c in ['a'..maxvar] then push(variables[c]) else if c in ['&', '|', '#', '¥'] then ope(c) end; calc := pop end;
procedure SetVarSet(n : integer); var c : char; begin for c := 'a' to maxvar do begin variables[c] := odd(n); n := n div 2 end end;
function powerof(n : integer) : integer; begin if n > 0 then powerof := powerof(pred(n)) * 2 else powerof := 1 end;
begin stack := nil; write('Enter term :'); readln(s); for i := 1 to powerof(ord(maxvar) - ord('a') + 1) do begin SetVarSet(i); for c := 'a' to maxvar do write(variables[c], ' '); writeln(calc(s)) end end.
procedure Minteger( var int: integer); begin repeat read(f, c) until c in['1','2','3','4','5','6','7','8','9','0']; if c in['1','2','3','4','5','6','7','8','9','0'] then int := ord(c) - ord('0'); end
procedure Extfile(var a:data; i :count); var x,y,z: integer; begin i := 0; while not eof(f) do begin { ファイル末尾でない限り } Minteger(int); x := int; Minteger(int); y := int; x := (10*x)+y; while not eoln(f) do begin i := i + 1; Minteger(int); y := int; Minteger(int); z := int; a[i] := (x*60) + (y*10) + z + 6; end; readln(f); { 改行文字を読み飛ばす } end; n := i; writeln(output); end;
