begin {main} {初期化} {定数} NULLTOKEN := chr(0); {字句がないことを表す文字コード.} {大域変数} error := FALSE; CurrentToken := NULLTOKEN; {評価} GetToken; {最初の字句があれば, 読み込む.} if CurrentToken = NULLTOKEN then writeln('Nothing input.') else begin result := expr; {字句の列を <式> として評価する.} if not error then {エラーが起きていなければ結果を表示する.} writeln(result) else writeln('Error occured.') end end.
とりあえず GetTokenの if ((ord('0') <= ord(ch)) and (ord(ch) <= ord('9'))) or (ch = '+') or (ch = '-') or (ch = '*') or (ch = '/') or (ch = '(') or (ch = ')') then でマイナスの場合はエラーを出すようになってるからそこをマイナスでもいけるようにすればいい
その場合charだと一文字しか入らないから-1とかだと2文字を入れることになる
このプログラムの場合2桁の数字をいれてもエラーがでるな
50 名前：43 mailto:sage [2006/01/20(金) 23:29:26 ]
すいません４５のところ間違ってました。訂正します。 function expr: integer; {<式>を評価する関数} var value: integer; function term: integer; {<項>を評価する関数} var value: integer; function factor: integer; {<因子>を評価する関数} var value: integer; function constant:integer; var value:integer; function digit: integer; {<数字>を評価する関数} begin{digit} if (ord('0') <= ord(CurrentToken)) and (ord(CurrentToken) <= ord('9')) then {CurrentTokenが<数字>ならば,} begin {その<数字>の順序数 - `0'の順序数} digit := ord(CurrentToken) - ord('0'); GetToken {を, その数字の評価値とする.} end else {そうでなければ, エラー.} begin error := TRUE; writeln('Error at digit.') end end; begin{consstant} value:=digit; while (ord('0') <= ord(CurrentToken)) and (ord(CurrentToken) <= ord('9')) do begin value:=value*10+digit; end; constant:=value; end;
51 名前：43 mailto:sage [2006/01/20(金) 23:32:23 ]
46も訂正しました。これなら2桁以上扱えるはずです。 マイナスは '-'ではいけないのでしょうか？ begin {factor} if CurrentToken = '(' then { <因子> が ( で始まるならば, } begin GetToken; factor := expr; {それ以降を <式>として評価し,} if CurrentToken = ')' then {その後に ) があることを確認する.} GetToken else { )がなければ, エラー.} begin error := TRUE; writeln('Error at factor.') end end else { <因子> が ( で始まらないならば,} factor := constant { その因子は<定数>として評価.} end;
function constant:integer; var value:integer; minus: boolean;
function digit: integer; begin{digit} … end; begin minus := CurrentToken='-'; if minus then GetToken; value:=digit; while (ord('0') <= ord(CurrentToken)) and (ord(CurrentToken) <= ord('9')) do value:=value*10+digit; if minus then constant := -value else constant := value; end;
procedure TForm1.Button1Click(Sender: TObject); const max=50; procedure line(x1,y1,x2,y2:integer); begin canvas.MoveTo(x1,y1);canvas.lineTo(x2,y2) end; procedure dia(x0,y0,r,n:integer) var xs,ys:integer;{始点} xe,ye:integer;{終点} i,j:integer; {ループ変数} t:real; {角度} begin t:=2*pi/n; for i:=1 to n-1 do begin xs := x0 + round(r*cos(t*i)); ys := y0 + round(r*sin(t*i)); for j:=i+1 to n do begin xe := x0 + round(r*cos(t+j)); ye := y0 + round(r*sin(t+j)); line(xs,ys,xe,ye) end end end; begin dia(300,20,70,11) end;
Score :array[0..1000] of integer; begin writeln('入力得点の平均と偏差値を計算します'); writeln('入力後、負の数を入力すると…終了します。'); kazu :=0; repeat write('点数は？'); readln(data); if data >= 0 then begin kazu := kazu + 1; score[kazu] := data end; until data < 0; goukei := 0; for i := 1 to kazu do goukei := goukei + score[i];heikin :=goukei / kazu; goukei :=0; for i := 1 to kazu do goukei := goukei + Sqr(score[i]);hensa := sqrt(goukei /kazu - sqr(heikin)); writeln('点数 偏差値'); for i := 1 to kazu do writeln(score[i]:4, 50 +10 * (score[i]-heikin)/ hensa:10:1); writeln(' 平 均 ＝',heikin:5:1); writeln('標準偏差＝',hensa:5:1); readln; end. ・・・こ、このプログラミングは・・・！！！直すとこ多すぎて説明めんどい・・・！！！！！！ とりあえず、for文でもif文でもuntilでもいいんだけど、for ～ do とかのあとが２行以上になる場合は必ずbegin をつけろ。あと、３科目データが入力されてない。最後のreadlnもwritelnの間違い。 そこも直せ。話はそれからだ
73 名前：ささ ◆6KVcpBNXy. [2006/01/27(金) 09:55:45 ]
教科書のプログラミングをそのまま書いたのですが… 三科目のデータを入力する言葉?がわかりません。
var Score :array[0..1000] of integer; i, kazu, data : integer; goukei, heikin, hensa : real; begin writeln('入力得点の平均と偏差値を計算します'); writeln('入力後、負の数を入力すると…終了します。'); kazu :=0; repeat write('点数は？'); readln(data); if data >= 0 then begin kazu := kazu + 1; score[kazu] := data end until data < 0; goukei := 0; for i := 1 to kazu do goukei := goukei + score[i]; heikin :=goukei / kazu;
74 名前：ささ ◆6KVcpBNXy. [2006/01/27(金) 09:56:33 ]
goukei :=0; for i := 1 to kazu do goukei := goukei + Sqr(score[i]); hensa := sqrt(goukei /kazu - sqr(heikin)); writeln('点数 偏差値'); for i := 1 to kazu do writeln(score[i]:4, 50 +10 * (score[i]-heikin)/ hensa:10:1); writeln(' 平 均 ＝',heikin:5:1); writeln('標準偏差＝',hensa:5:1); readln; end.
const kyouka = 3; Kazu = 10; kyoukaNames: Array[0..(kyouka-1)] of String = ('国語', '理科', '数学'); var ScoreArray: Array[0..(Kazu-1), 0..(kyouka-1)] of Integer; i, j, Sum1: Integer; Sum2: Extended; begin writeln('入力得点の合計と教科ごとの平均を計算します');
for i := 0 to (Kazu-1) do begin writeln(Format('%d人目の得点を入力してください', [i+1])); readln(ScoreArray[i, 0], ScoreArray[i, 1], ScoreArray[i, 2]); Sum1 := ScoreArray[i, 0]+ScoreArray[i, 1]+ScoreArray[i, 2]; writeln(Format('%d人目の合計点は%d', [i+1, Sum1])); end;
for j := 0 to (kyouka-1) do begin Sum2 := 0; writeln(KyoukaNames[j]+'の平均は'); for i := 0 to (Kazu-1) do Sum2 := Sum2+ScoreArray[i, j]; Sum2 := Sum2 / Kazu; writeln(Format('%.4f点です', [Sum2])); end;
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.
