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;
procedure ArriveSin(var Ax:integer); var x,y,z,mi: integer; k: count; begin if (d = 1) then begin reset(f, 'HolyUmeda'); writeln('Holyを読み込み増した。') end else begin reset(f, 'WeekUmeda'); { ファイルを開く } writeln('Weekを読み込み増した。') end;
Extfile(a, i);
if (h < 14) then begin k := 1; while a[k] <= mi do k := k+1; Ax := a[k-1]; end else begin k := n; while a[k] > mi do k := k-1; writeln('a[',k,'] = ',a[k]); Ax := a[k]; end; close(f) end;
procedure term(operation : char); var operand, tempterm : string; begin if operation in ['&', '|', '#'] then operand := popt; with stack^ do begin case operation of '&' : tempterm := term + ' and ' + operand; '|' : tempterm := term + ' or ' + operand; '#' : tempterm := term + ' xor ' + operand; '¥' : tempterm := 'not ' + term end; term := '(' + tempterm +')' end end;
function disp(source : string) : string; var i : integer; c : char; begin for i := 1 to length(source) do begin c := source[i]; if c in ['a'..maxvar] then pusht(c) else if c in ['&', '|', '#', '¥'] then term(c) end; disp := popt end;
>>553です。ありがとうございます。 教えていただいたプログラムに549ー550を加えてみました。 Program Viva2chan; const maxvar = 'c'; type pnode= ^node; node = record value : boolean; term : string; 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;
556 名前：デフォルトの名無しさん [2007/08/07(火) 15:52:20 ]
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 := not value end end;
557 名前：デフォルトの名無しさん [2007/08/07(火) 15:53:13 ]
function disp(source : string) : string; var i : integer; c : char; begin for i := 1 to length(source) do begin c := source[i]; if c in ['a'..maxvar] then pusht(c) else if c in ['&', '|', '#', '\'] then term(c) end; disp := popt 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.
558 名前：デフォルトの名無しさん [2007/08/07(火) 15:54:01 ]
5ー7行目を549のように書き換えました。 60ー83行目に549ー550を追加しました。 コンパイルすると push, pop, ope, calc, SetVarSet, term "datakozo.p", line 62: Warning: Symbol 'POPT' is not defined [221] "datakozo.p", line 62: Warning: Mixing non-strings with strings [170] , disp "datakozo.p", line 80: Warning: Symbol 'PUSHT' is not defined [221] "datakozo.p", line 83: Warning: Symbol 'POPT' is not defined [221] "datakozo.p", line 83: Warning: Mixing non-strings with strings [170] , powerof, Viva2chan
program EX01(input,output); var D1,D2,S,D,P,Q:integer; begin read(D1,D2); S:=D1+D2;D:=D1-D2;P:=D1*D2;Q:=D1 dir D2; writeln(D1,D2); writeln(S,D,P,Q); end. 整数の四則演算なのですが、Windowsで保存するときの拡張子を教えてください。
コマンドプロンプトでは、 C:\Documents and Settings\user>cd My Documents C:\Documents and Settings\user\My Documents>bcc32 EX01.pas C:\Documents and Settings\user\My Documents>EX01.exe って感じでおｋですか？
てへ、もういっちょ教えてくださいｗ さっきのを、整数じゃなくて実数にするのですが、 program PR01(input,output); real D1,D2,S,D,P,Q:integer; begin read(D1,D2); S:=D1+D2;D:=D1-D2;P:=D1*D2;Q:=D1/D2; writeln(D1,D2); writeln(S,D,P,Q); end. だとエラーが出るんですけど、どこが違うのでしょう？
program PR0203(input,output); var W,L,H,V,S:integer; begin readln(W,L);raldln(H);writeln(W,L,H); V:=W*L*H;S:=2*(W*(L+H)+L*H); writeln(V,S); end.
これでエラーが出るのは何故なんでしょう？
PR0203.pas(4,21) Error: Identifier not found "raldln" PR0203.pas(4,24) Error: Illegal expression PR0203.pas(4,25) Warning: Variable "H" does not seem to be initialized PR0203.pas(8) Fatal: There were 2 errors compiling module, stopping Fatal: Compilation aborted Error: C:\FPC\2.2.0\bin\i386-Win32\ppc386.exe returned an error exitcode (normal if you did not specify a source file to be compiled)
program PR0331(input,output); var D1,D2:real; var T1,T2,T3,T4,R1,R2,R3,R4:integer; begin read(D1,D2); T1:=trunc(D1);T2:=trunc(D2);T3:=trunc(-D1);T4:=trunc(-D2); R1:=round(D1);R2:=round(D2);R3:=round(-D1);R4:=round(-D2); writeln('trunc(',D1:2:1,')=',T1:2,'trunc(',D2:2:1,')=',T2:2,'trunc(',-D1:2:1,')=',T3:2,'trunc(',-D2:2:1,')=',T4:2); writeln('round(',D1:2:1,')=',R1:2,'round(',D2:2:1,')=',R2:2,'round(',-D1:2:1,')=',R3:2,'round(',-D2:2:1,')=',R4:2); end.
writeln('Data Entered : ', D1, D2); writeln('Trunc''s of them are ', trunc(D1), ' and ', trunc(D2), ' respectivly.'); writeln('Trunc''s of negated them are ', trunc(-D1), ' and ', trunc(-D2), ' respectivly.'); writeln('Round''s of them are ', round(D1), ' and ', round(D2), ' respectivly.'); writeln('Round''s of negated them are ', round(-D1), ' and ', round(-D2), ' respectivly.'); writeln('Thus, both functions are (different from / same for) each other in case of (you must fill this parenthesis ).')
