これであと学籍番号を一緒に表示したいにですが、どうすればいいですか？ SysUtils; type rec=record name:String; ten:integer; end;var stud:array[1..5]of rec; i,j,w:integer;
begin { TODO -oUser -cConsole Main : この下にコードを記述してください } for i:=1 to 5 do begin write('no.',i,' 学籍番号：'); readln(stud[i].name); write('no.',i,' 点数：'); readln(stud[i].ten) end;
for i:=1 to 5-1 do for j:= i+1 to 5 do if stud[j].ten>stud[i].ten then begin w:=stud[i].ten; stud[i].ten:=stud[j].ten; stud[j].ten:=w end;
writeln; for i:=1 to 5 do writeln(stud[i].ten); writeln; readln; end.
(1) 配列にしまわれたいくつかの整数をデータとして， 棒グラフを作成するプログラムをかけ。 （入力データ x は 0<= x <=100 をみたすとする。） Hint: 以下の作業を，i=1 から i=n まで， n 回繰り返す （ for 文や repeat 文を用いる） 作業： x 方向に位置をずらしながら， a[i] に応じた高さの細長い長方形を n 個描く
program gcd(input, output); var x0, y0, x, y, w, a1, b1, a, b, q1, u, v : integer; begin readln(x0, y0); if (x0 > 0) and (y0 > 0) then begin x := x0; y := y0; a := 1; b := 0; while x <> 0 do begin w := y mod x; y := x; x :=w; q1 := y0 div x0; a1 := b - q1 * a; b := a; a := a1 end; u := b; v := ( y - u * x0 ) div y0; writeln('gcd(', x0:1, ', ', y0:1, ') = ', y:1); writeln('(u,v)=(', u:1, ',', v:1, ')') end end.
type pointer = ^celltype; celltype = record element : char; next : pointer; end;
var listA,listB,listC : pointer; x : char;
427 名前：デフォルトの名無しさん [2006/11/14(火) 02:22:42 ]
procedure insert(var p : pointer; a : char);
var q : pointer;
begin new(q); q^.element:=a; q^.next:=p; p:=q; end; { insert }
procedure print(p : pointer);
begin while p<>nil do begin write(p^.element,' '); print(p^.next) end end; { print }
428 名前：デフォルトの名無しさん [2006/11/14(火) 02:24:02 ]
begin readln(x); while x<>'.' do begin insert(listA,x); readln(x) end; if listA^.element<>'.' then begin print(listA) end; writeln(); dispose(listA) end.
begin while p<>nil do begin found:=false; while q<>nil do begin if p^.element=q^.element then found:=true else q:=q^.next end; if found then begin new(r); insert(r,p^.element) end; p:=p^.next end end; { search }
432 名前：デフォルトの名無しさん [2006/11/14(火) 22:35:54 ]
あと、メインプログラムで
if listA^.element<>'.' then begin print(listA) end;
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;
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 ).')
605 名前：デフォルトの名無しさん [2007/10/09(火) 21:31:21 ]
program PR0331(input,output); const D1=0.4;D2=0.5;D3=-0.4;D4=-0.5; var T1,T2,T3,T4,R1,R2,R3,R4:integer; begin T1:=trunc(D1);T2:=trunc(D2);T3:=trunc(D3);T4:=trunc(D4); R1:=round(D1);R2:=round(D2);R3:=round(D3);R4:=round(D4); writeln('trunc(',D1:4:1,')=',T1:2,' trunc(',D2:4:1,')=',T2:2,' trunc(',-D1:4:1,')=',T3:2,' trunc(',-D2:4:1,')=',T4:2); writeln('round(',D1:4:1,')=',R1:2,' round(',D2:4:1,')=',R2:2,' round(',-D1:4:1,')=',R3:2,' round(',-D2:4:1,')=',R4:2); end.
program PR0311(input,output); ver D1,D2:integer; ver O1,O2,E1,E2:Boolean; begin read(D1,D2); O1:=odd(D1);D2:=odd(D2); E1:=even(D1);E2:=even(D2); writeln(' odd(',D1,')=',O1);writeln(' odd(',D2,')=',O2); writeln('even(',D1,')=',E1);writeln('even(',D2,')=',E2); end.
program PR0311(input,output); ver D1,D2:integer; begin read(D1,D2); writeln(' odd(',D1,')=',odd(D1));writeln(' odd(',D2,')=',odd(D2)); writeln('even(',D1,')=',even(D1));writeln('even(',D2,')=',even(D2)); end.
エラーメッセージ Free Pascal Compiler version 2.2.0 [2007/09/09] for i386 Copyright (c) 1993-2007 by Florian Klaempfl Target OS: Win32 for i386 Compiling PR0311.pas Fatal: Syntax error, "BEGIN" expected but "identifier VER" found 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 Viva2chan(output); type courses = (programming, algebra, circuit, english, electromagnetics); coursset = set of courses; var studentA, studentB, studentC : coursset;
procedure DispSet(s : coursset); begin if programming in s then write('Programming'); if algebra in s then write('Algebra'); if circuit in s then write('Circuit'); if english in s then write('English'); if electromagnetics in s then write('Electromagnetics'); writeln end;
function factrial(i:integer): real; begin if n=1 then begin factrial := 1; end else begin factrial := i*factrial(i-1); end; begin write('Enter n : '); readln(n); For i:=1 to n do begin ANS:=1+(1/factrial); end; end;
function factrial(i:integer): real; begin if n=1 then begin factrial := 1; end else begin factrial := i*factrial(i-1); end; begin write('Enter n : '); readln(n); For i:=1 to n do begin ANS:=ANS+(1/factorical(i)); end; end; begin
function factorial(i:integer) : real; begin if i = 1 then factorial := 1 else factorial := i * factorial(i - 1) end; begin write('Enter n : '); readln(n); For i := 1 to n do ANS := ANS + (1. / factorial(i)); writeln('N = ', n, ' ANS = ', ANS:8:6); readln; end.
const USD = 118.94; GBP = 186.53; CNY = 13.93; EUR = 129.60; RUB = 3.73; var c : char; j, k : real; begin repeat writeln('********************'); writeln('d--USDOLLAR'); writeln('P--British Pound'); writeln('y--Chinese Yuan(gen)'); writeln('e--Euro'); writeln('r--Russian Rouble'); writeln('*****************'); write('Exchange to : '); readln(c); until (c = 'd') or (c = 'P') or (c = 'y') or (c = 'e') or (c = 'r'); write('Enter the amout of money in JPY : '); readln(j); case c of 'd' : begin k := j / USD; writeln('USD = $', k : 8 : 2) end; 'P' : begin k := j / GBP; writeln('GBP = ', k : 8 : 2, ' pound') end;
>>668 program prog1(input, output); var i,j,k : integer; a:array[1..9] of array[1..9] of array[1..9] of integer; begin for i := 1 to 9 do for j :=1 to 9 do for k :=1 to 9 do a[i,j,k]:=i*j*k;
for i := 1 to 9 do begin writeln('i=',i); for j := 1 to 9 do begin for k :=1 to 9 do write(a[i,j,k]:6); writeln(); end end end.
>>671 program prog1(input, output); var x,c: real; function f(x,c : real) :real; begin f := x*x-c; end;
function fd(x : real) :real; begin fd := 2*x; end; begin writeln('ｘの平行根の近似値を求めます'); write('x : '); read(c); x := c; while abs(f(x,c)) >0.0001do begin writeln(x,' ',f(x,c)); x := x-f(x,c)/fd(x); end; writeln(c,'の平行根の近似値は',x); end.
program prog1(input, output); var kame, turu, goukei, asi, tasi,sa: integer; begin write('鶴と亀の数は？'); readln(goukei); write('足の数は？'); readln(asi); tasi :=2*goukei; writeln('全部鶴だと仮定すると足の数は',tasi); sa := asi-tasi; writeln('実際の足の本数との差は', sa); writeln('鶴の代わりに亀が一匹入ると2本足が増える'); kame := trunc(sa/2); writeln('だから亀の数は', sa, '÷2＝',kame); turu := goukei-kame; writeln('鶴の数は',turu); end.
program ensyu9(input,output); var i,data,answer : integer; begin randomize; answer := random(5); if data = answer then for i:=1 to 5 do begin readln(data); if data > answer then writeln('大きい') else if data < answer then writeln('小さい') else if data = answer then writeln('当たり') end; end.
>>680 >>681がWhileなら俺はrepeat～untilで行こうかな。 program ensyu9(input,output); var i,data,answer : integer; begin randomize; answer := random(5); i:=1; repeat readln(data); if data > answer then writeln('大きい') else if data < answer then writeln('小さい') else if data = answer then writeln('当たり'); i:=i+1; until (i>5) or (data = answer) end.
こんな感じの問題です。最後の-1はプログラムを終了させるためにあるようです。 使用する処理は、while ifあたりを指定されています。 自分は以下のように作ったのですが、runtime error 200 at 0001:017E というエラーが表示されてしまい、実行できませんでした。
689 名前：688 mailto:sage [2007/11/20(火) 16:07:52 ]
program kadai06(input,output); uses wincrt; const kijun=170; var n,n1,n2:integer; a1,a2,a,x,s1,s2:real; begin n1:=0; n2:=0; a1:=0; a2:=0; read(x); while x>=0 do begin if x>=kijun then begin s1:=a1*n1; n1:=n1+1; a1:=(s1+x)/n1; end else begin s2:=(a2*n2); n2:=n2+1; a2:=(s2+x)/n2; end;
>>704 program prog1(input, output); var n,a,b : integer; begin write('初項a : '); read(a); write('公差b : '); read(b); for n := 1 to 20 do writeLn(n:3, (a+b*(n-1)):10); 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(100,400,70,11) end;
DelphiのVCLを使えるの？ なら procedure PaintAngle(Canvas:TCanvas;x0,y0,r0,deg:Integer); var w:Extended; i:Integer; pt:array [0..2] of TPoint; begin w:=PI/180.0*deg; for i:=0 to 3-1 do begin pt[i].x:=round(x0+r0*sin(w)); pt[i].y:=round(y0+r0*cos(w)); w:=w+2*PI/3; end; Canvas.Polygon(pt); end; //試験コード var x0:Integer=200; y0:Integer=200; r0:Integer=100; deg:Integer=0; ///////////// タイマーを貼り付けてダブルクリック procedure TForm1.Timer1Timer(Sender: TObject); begin Invalidate; deg:=deg+10; end; ///////////// フォームのOnPaintに procedure TForm1.FormPaint(Sender: TObject); begin PaintAngle(Canvas,x0,y0,r0,deg); end;
カエサル暗号とは、各文字をアルファベット順で３つ後の文字に置き換える暗号方式である。 カエサル暗号を拡張し、標準入力から入力された数字だけ平文の文字をずらす暗号化を実現せよ。 平文（暗号化前の文章）が書かれたファイルを入力とし暗号化されたものを出力ファイルに書き出すプログラムを作成せよ。 (例) 6が入力された場合 I am a pen. →O gs g vkt.
関数f(x0)=0、a 以上 x0 未満の値 x について f(x)<0 x0 より大きく b 以下の値 x について f(x)>0 の時、 f(a) と f(b) を通る直線と x 軸との交点を求め、その値を c としたとき f(c)<0 であれば c を新たな a とし、f(c)>0 であれば c を新たな b とする この操作を回数繰り返しいずれかの値を x0 とする。
関数f(x0)=0、a 以上 x。 未満の値 x について f(x)<0 x。 より大きく b 以下の値 x について f(x)>0 の時、 f(a) と f(b) を通る直線と x 軸との交点を求め、その値を c としたとき f(c)<0 であれば c を新たな a とし、f(c)>0 であれば c を新たな b とする この操作を数回繰り返しいずれかの値を x。 とする。
//２点を通る直線とＸ軸の交点Ｙを求める function xCross(ax,ay,bx,by:Double):Double; var a,b:Double; begin a := (ay*bx - by*ax)/(bx-ax); b := ay - a*ax; Result:=-b/a; end; //問題中のf(x)式、初期値をx0とする。 function f(x,x0:Double):Double; begin Result:= x*x - x0*x0; end; //今回の問題を解くメインループ function test(x,a,b:Double):Double; var x0,c,fa,fb:Double; begin x0:=0; while ((a<x) and (x<x0) and (f(x,x0)<0)) or ((x0<x) and (x<b) and (f(x,x0)>0)) do begin c := xCross(a,f(a,x0),b,f(b,x0)); if f(c,x0)<0 then a:=c else if f(c,x0)>0 then b:=c; x0:=c; end; Result:=x0; end;
>>784 これ、ニュートン法と呼ばれる平方根を求めるアルゴリズムですね 問題が非常に不鮮明で最初の一文が無いと到底理解できない設問です。 ハッキリ言って悪題ですね。 きわめてシンプルにするとこんな感じになります。 function fSqrt(x:Double):Double; var s,last:Double; begin Result:=0; if x<=0 then exit; if x>1 then s:=x else s:=1; repeat last := s; s := (x/s+s) * 0.5; until s<last; Result:=last; end; 原理は簡単なので「平方根、ニュートン法」で調べてください。 ターミナルはwindowsのネットワーク越しにコンパイルを行う通信クライアントだと思われます。 もしかしたら、コンパイラはPascalじゃなくCかもしれません。 使用言語やコンパイル自体が分からない場合は友達と相談してください。 でわでわ。
emacsでプログラム書いてるのですが、 error: invalid operands to `+' error: incompatible type for argument 2 of `ace' error: routine declaration error: result of function `check' not assigned ↑のエラーの消し方がわからないのです 教えていただけないでしょうか
「Ⅰ」 procedure quicksort( var ar: intarray; var i, j: integer ); var {b1 はサブリスト sub1 の始めの要素番号、e1 は終わりの要素番号} {b2 はサブリスト sub2 の始めの要素番号、e2 は終わりの要素番号} b1, e1, b2, e2: integer; begin if i ＜ j then begin b1 := i; e2 := j; divide( ar, b1, e1, b2, e2 ); quicksort( ar, b1, e1 ); quicksort( ar, b2, e2 ); end; end;
812 名前：デフォルトの名無しさん [2008/11/30(日) 16:20:16 ]
「Ⅱ」 procedure divide( var A: intarray; var b1, e1, b2, e2: integer ); var x, y, temp: integer; begin x := b1; y := e2; while x < y do begin if A[x] > A[x+1] then begin temp := A[x]; A[x] := A[x+1]; A[x+1] := temp; x := x + 1; end else begin temp := A[y]; A[y] := A[x+1]; A[x+1] := temp; y := y - 1; end; end; e1 := x - 1; b2 := y + 1; end;
>>811-812をそのまま使って program aaa(input, output); const n=10 ; type intarray= array[1..n] of integer ; var A : intarray; begin Aにデータ入力 quicksort(A,1,n); データ出力 end. でいいんじゃないかな
program test(input, output); const m=3;n=10; type index=1..m; var a : array[index,index] of real; x ,y : array[index] of real; i,k,h : index ; s :real ;
{ y =Ax の計算を10回} for h:= 1to n do begin { y =Ax の計算1回分} for i := 1 to m do begin s := 0; for k:=1 to m do begin s := s + a[i,k] * x[k] ; end; y[i] := s ; end; x:=y ; end; {n秒後にA,B,Cにいる確率、順に} for i := 1 to m do writeln(x[i]); end.
課題で１～ｎの総和計算の発展形の１～ｎ^2の総和計算を求める、というものがありました。 １～ｎの挿話計算が var i,sum,n:integer; begin write('n='); readln(n); sum := 0; for i:=1 to n do sum := sum +i; writeln('Sum(1～n)=',sum) end; となるのはわかったんですが、これをn^2にするときは、 上のプログラムのnをsqr(n)に変えるだけでできますか？
823 名前：デフォルトの名無しさん [2008/12/12(金) 00:58:27 ]
822です。引き続け申し訳ないですが、 6つの4,89,6,2,23,21という数字を小さいものから並び替えるプログラム procedure sort; const N = 6; const d: array[1 .. N] of integer = (4,89,6,2,23,21); var i, j, w: integer; sd: array[1 .. N] of integer; begin for i := 1 to N do sd[i] := d[i]; for i := 1 to N do for j := 1 to N - i do if sd[j] > sd[j+1] then begin w := sd [j]; sd[j] := sd[j+1]; sd[j+1] := w end; writeln('Sorted date :'); for i := 1 to N do write('sd[',i:3,'] '); writeln; for i := 1 to N do write(sd[i]:7,' ');writeln; readln end; を改良して、6つの数字のうち初めのM個だけを並び替えるという プログラムのつくりかたがわかりません。 どなたか教えていただけたら幸いです。
(* Standard ML *) fun permutation [] = [[]] | permutation list = let fun revolve [] = [[]] | revolve l = let fun shift 0 _ = [] | shift n (x::xs) = (x::xs) :: (shift (n-1) (xs@[x])) in shift (length l) l end fun permutation' [] = [[]] | permutation' (x::xs) = map (fn y => x::y) (permutation xs) in foldr (op @) [] (map permutation' (revolve list)) end;
(* 実行結果 *) - permutation [1,2,3]; val it = [[1,2,3],[1,3,2],[2,3,1],[2,1,3],[3,1,2],[3,2,1]] : int list list - permutation [1,2,3,4]; val it = [[1,2,3,4],[1,2,4,3],[1,3,4,2],[1,3,2,4],[1,4,2,3],[1,4,3,2],[2,3,4,1], [2,3,1,4],[2,4,1,3],[2,4,3,1],[2,1,3,4],[2,1,4,3],...] : int list list -
program prog1(input, output); var i,n : integer; p : array[1..10] of integer ;
procedure perm(i,n:integer); var j,t :integer; begin if i<n+1 then begin for j:=i to n do begin t:=p[i] ; p[i]:=p[j] ; p[j]:=t ; perm(i+1,n); t:=p[i] ; p[i]:=p[j] ; p[j]:=t ; end; end else begin for j :=1 to n do write(p[ j ],' '); writeln(''); end; end;
begin write('n='); read(n); for i := 1 to n do p[i]:=i; perm(1,n); end.
program prog1(input, output); const pi=3.1415926535; var i:integer; s,c,t:real; begin writeln('deg','sin':8,'cos':10,'tan':10); for i := 0 to 360 do begin s := sin(i*2*pi/360); c := cos(i*2*pi/360); if (i mod 15) = 0 then begin if (i mod 180 = 90) or (c= 0) then writeln(i:3,s:10:5,c:10:5,'-------':10) else writeln(i:3,s:10:5,c:10:5,s/c:10:5) ; end; end; end.
program prog1(input, output); var i ,x1,x2,x3,y1,m1,d1,y2,m2,d2: integer;
function calcd(y,m,d:integer):integer; var i,leapday,years,days,mdays:integer; begin years := y-1; days := d; days := days + years * 365; days := days + trunc (years/4) - trunc (years/100) + trunc (years/400); if ( (y mod 4 =0) and (y mod 100 <>0) and (y mod 400 =0) ) then leapday := 1 else leapday := 0; for i:=1 to m - 1 do begin case i of 1,3,5,7,8,10,12 : mdays := 31; 4,6,9,11 : mdays := 30; 2 : mdays := 28 + leapday ; end; days := days + mdays; end; calcd:=days; end;
begin writeln('next birthday'); write('year=');readln(y1); write('month=');readln(m1); write('day=');readln(d1); writeln('today'); write('year=');readln(y2); write('month=');readln(m2); write('day=');readln(d2); x1:=calcd(y1,m1,d1); x2:=calcd(y2,m2,d2); x3:=x1-x2; write('tanjobi made ',x3,' nichi'); end.
program Mat(input,output,ExtFile); const COL = 4; ROW = 4;
type Matrix = packed array [1..COL,1..ROW] of integer; MatrixFile = file of Matrix;
var ExtFile : MatrixFile; i : 1..COL; j : 1..ROW; InputMatrix : Matrix;
begin rewrite( ExtFile, 'ExtFile' ); for i := 1 to COL do begin for j := 1 to ROW do begin write( '[', i, ',', j, ']?:' ); readln( InputMatrix[i,j] ) end end; write( ExtFile, InputMatrix ) end.
>>875 動作確認なんてしてないから間違ってたらすまん 改行大杉って怒られたんでつめて書く type TMatrix3x3 = array[0..2][0..2]of Double; function det3x3(Mat:TMatrix3x3):Double; var i,j:Integer; hoge:Extended; begin Result:=0; //Plus for i:=0 to 2 do begin hoge:=1;
for j:=0 to 2 do hoge:=hoge*Mat[j][(i+j)mod 3];
Result:=Result+hoge;
end; //Minus for i:=0 to 2 do begin hoge:=1; for j:=0 to 2 do
