Pascalの宿題は俺にや ..
153:デフォルトの名無しさん
06/02/08 02:12:25
直りました。
var init,current:list;
datname:string[20];
datid:integer;
begin
new(init);
current:=init;
write('名前を入力してください： '); readln(datname);
current^.name:=datname;
while datname <> 'end' do begin
write('IDを入力してください： '); readln(datid);
current^.id:=datid;
new(current^.pointer);
current:=current^.pointer;
write('名前を入力してください: '); readln(datname);
current^.name:=datname
end;
current^.pointer:=nil;
{リストの書き出し}
current:=init;
while current^.pointer <> nil do begin
write(current^.name,' ',current^.id,' ');
current:=current^.pointer
end;
writeln
end.
154:デフォルトの名無しさん
06/02/08 02:14:15
問題はここからですね。入れ替える位置pを入力して、p番目の要素とp番目の次の
要素を入れ替えなさい。
155:デフォルトの名無しさん
06/02/08 12:31:22
できない・・・。currentの前を指すpreviousを用意して
currentとpreviousのpointerを入れ替えればできるか思ったのですが
無限ループになってしまいます。
削除と挿入ならできるのに・・。
156:774RR
06/02/08 12:32:36
この手の課題でリストの頭と尻尾にダミーをいれておいて、
必ず3個以上の要素が存在するようにするのは
極普通のプログラミングテクニックで、やらないほうが変だと思うが…
「次」を示すフィールドがnextだとするね。
p-1番目の要素を見つける所から始める。
これはwhile文で頭から律儀に数えるしかない。
その上で、
ppred ← p-1番目の要素を指すポインタ
pp:=ppred^.next ← p番目の要素を指すポインタ
psucc:=pp^.next ← p+1番目の要素を指すポインタ
をまずやっとく。
pwork := psucc^.next;
ppred^.next := psucc;
psucc^.next := pp;
pp^.next := pwork;
これでppred->psucc->pp->元のpsuccの次って順序になった。
psucc, pp, ppred, pworkは全部局所変数でおけ。
>146
record型のデータの部分がでかい場合、コピするのにマシンサイクルを
使い過ぎる。簡単に張り替えられるのがリストの利点よん。
157:デフォルトの名無しさん
06/02/08 19:46:04
ありがとうございます。
currentとpreviousとtempのほかにもうひとつ必要だったのですか。
そうすると、メインプログラムも変えないとだめってことでしょうか？
158:デフォルトの名無しさん
06/02/08 19:54:31
メイン変えなくてもできますね。とりあえず、できました。次を示すフィールドをpointerとして
ppred・・previous
pp・・current
psucc・・next
pwork・・tempになってます。
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;
159:774RR
06/02/08 20:44:27
手続きを仕えってなら、こんなのはどうだ?
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;
160:774RR
06/02/08 20:45:13
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;
161:774RR
06/02/08 20:45:49
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;
procedure initlist;
begin
new(top);
new(tail);
top^.next := tail;
tail^.next := nil
end;
162:774RR
06/02/08 20:46:44
procedure disposelist;
var p : plist;
begin
p := top;
while top<>nil do begin
p := top^.next;
dispose(top);
top := p
end
end;
163:774RR
06/02/08 20:47:23
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.
164:デフォルトの名無しさん
06/02/08 20:53:39
読まずにすまそ。壱から書く方がらくなんで…
粘着もすまそでつ。
最近もの書きばっかやっているんで
たまにプログラムを書かないと脳が腐る ●rz
165:774RR
06/02/08 20:54:35
↑いけねえハン忘れた orz
ともかく帰依まつ
166:デフォルトの名無しさん
06/02/08 20:57:01
ありがとうございます。
この問題はもう解けました。
次の問題は、カーソルによるリスト構造の実現で、INSERT、DELETE,配列SPACEの全
セルを使用可能スペースリストにつなぐinitializeの手続きにエラーチェックを加え、メインプログラム
にて確認しなさい。という問題なのですが、これからそれぞれの手続きを書きますのでよろしく
お願いします。
参考：URLﾘﾝｸ(www.elect.chuo-u.ac.jp)
これはC？で書いてあります。
167:デフォルトの名無しさん
06/02/08 21:01:46
まず、基本的な型宣言から
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;
168:デフォルトの名無しさん
06/02/08 21:11:53
手続き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}
169:デフォルトの名無しさん
06/02/09 16:05:59
誰か識者の方、166-168の問題解いてもらえませんか？
よろしくお願いします。
170:デフォルトの名無しさん
06/02/10 12:46:42
与えられた自然数 n(n>=3) に対し、正n角形とその対角線を表示するプログラムを作れ。
ただし、Readlnでnの値を読み込んでから作図するようにせよ。
TopPascalのこのような課題が出ました。
どうか皆様の力をお貸しください。
171:デフォルトの名無しさん
06/02/16 09:43:19
170に答えてください。お願いします。
172:デフォルトの名無しさん
06/02/16 10:08:26
>>171
お前は１週間何やってたんだと小一時間説教してやる。
173:デフォルトの名無しさん
06/02/16 11:18:23
そろそろ説教も終わった頃かね
TopPascalもコマンドラインで描画の方法も知らんけど、
Delphi で n 角形の各頂点の位置なら
procedure GetApex(ApexCount: Integer;// 頂点の数
Radius: Integer; // 外接円の半径
Center: TPoint; // 外接円の中心
var Apexes: array of TPoint); // 結果
var
i: Integer;
CurAngle: Double;
begin
// 初期値
CurAngle := 0;
for i := 0 to ApexCount - 1 do
begin
Apexes[i].X := Center.X + Trunc(Radius * Cos(CurAngle));
Apexes[i].Y := Center.Y + Trunc(Radius * Sin(CurAngle));
CurAngle := CurAngle + 2 * PI / ApexCount;
end;
end;
てけとーに真似してやってみれ
174:デフォルトの名無しさん
06/02/16 20:41:13
ありがたいのですが、Delpiってのはわからないんで…。
できればどなたかコピペしてランすればできるのを提供していただけないでしょうか？
175:デフォルトの名無しさん
06/02/16 21:26:19
ﾌﾟｷﾞｬ━━m9｡ﾟﾟ(ﾟ^Д^≡^Д^ﾟ)ﾟﾟ｡9m━━!!!!
176:デフォルトの名無しさん
06/02/17 00:14:19
デルピ
177:デフォルトの名無しさん
06/02/17 02:40:34
もうデルピーは居ないんだよ・・・
178:デフォルトの名無しさん
06/02/17 05:12:41
次はデルピーって言うのか出るのが楽しみだ(ﾉ´∀｀*)
179:デフォルトの名無しさん
06/02/20 01:59:19
「■全く分かってない阿呆も放置しないで優しく対応」という
ことに甘えまして、宜しくお願いいたします。
文字列型(あくまで)で、00～ffに対し、
最終integer型で0～255に変換したいのですが・・。
たとえば、
var
a:string;
b:integer;
begin
a:='2f';
･
･
･
･
write(b);
end.
ここでのＣＲＴ出力を
「47」
としたい訳です。
どのような手法で可能でしょうか？ご教示下さい。
180:デフォルトの名無しさん
06/02/20 08:45:30
0-fの文字を0-15の整数に変換する関数hogeを書く。
hogeを使って一文字づつ変換して１６倍するループを書く。
181:デフォルトの名無しさん
06/02/20 19:40:25
>>180
有り難うございます、一寸やってみます。
182:デフォルトの名無しさん
06/02/22 01:09:37
こんなのどうですか。
function HexToInt(const S: string): Integer;
const
Table: array['0'..'F'] of Integer =
(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, -1, -1, -1, -1, -1, -1,
-1, 10, 11, 12, 13, 14, 15);
var
I: Integer;
begin
Result := 0;
for I := 1 to Length(S) do
Result := Result shl 4 + Table[UpCase(S[I])];
end;
183:デフォルトの名無しさん
06/02/22 04:56:14
解析してアセンブラまで戻すにはするにはどうしたらいいですか？
184:デフォルトの名無しさん
06/02/22 10:52:30
ファイト
185:デフォルトの名無しさん
06/02/24 19:58:02
一発
186:デフォルトの名無しさん
06/03/24 06:02:22
―益
187:デフォルトの名無しさん
06/04/11 17:32:22
時、分、秒で表した時間の和を計算するプログラムを作成したい。 但し、以下の条件を満たすように作成し、
プログラムと適当なデータを入力した結果と一緒に提出せよ。
1. データは日、時間、分、秒を表す整数型のフィールド名 day, hour, minute, second のレコード型で定義し、
レコード名を time とせよ。プログラム名を Toi2 とし、 秒と分の計算課程は同一であるため、
その個所は手続きを使って表現せよ。
2. 入力として、時、分、秒の 3個のデータを 2セット入力し、その和を出力せよ。
3. もし、 hour の値が 24 以上であれば day に１の値を、 24未満であれば零にせよ。
188:デフォルトの名無しさん
06/04/11 17:34:13
フィボナッチ数列の項は、その直前の連続する二つの項の和である。
f( n ) = f( n - 1 ) + f( n - 2 )
但し、 f(0) = 0, f(1) = 1 である。
フィボナッチ数列の連続する項の差の比
z(n) = { f( n - 1 ) - f( n - 2 ) }/ { f( n ) - f( n - 1 ) }
は、 n が大きくなれば、ある値に収束する。この値の近似値を求める プログラムを書き、その値を示せ。この値は黄金分割比と呼ばれる。
プログラム名を Toi3 とし、フィボナッチ数列は関数 fibonacci を作って求め、項は配列に表せ。数列は 100項まで とする。
1. まず f(30)の項まで求めz(n)の値を出力させるプログラムを作り、その値が 収束していく様子を出力して確かめよ。
2. 次に、1.のプログラムを書き換えて、収束判定のために定数 dif = 1.0 e -6 を宣言し、
連続する z(n-1),z(n) の差の 絶対値が dif 以下になったとき、収束したとして計算を終了する プログラムを作り、
プログラムとその計算結果を提出せよ。
もし、n=100でも 収束しない場合、z(100)の値と”収束しなかった”文を出力せよ。
189:774RR
06/04/11 18:52:31
Program Toi2;
type
time = record
day, hour, minute, second : integer
end;
var t1, t2, t3 : time;
procedure add60(a, b : integer; var c : integer; var carry : boolean);
(* a + b must be less than 120 *)
begin
c := a + b;
carry := (c >= 60);
c := c mod 60
end;
begin
(* データを読む1 -> t1 *)(* データを読む2 -> t2 *)
add60(t1.second, t2.second, t3.second, cry);
add60(t1.minute, t2.minute + ord(cry), t3.minute, cry);
with t3 do begin
hour := t1.hour + t2.hour + ord(cry);
if hour >= 24 then begin
day := 1; hour := hour -24
end else
day := 0
end;
(* 表示 *)
end.
190:デフォルトの名無しさん
06/04/11 19:43:31
>>189
carryとcryをintegerにしてcarry:=(c>=60);をcarry:=c div 60;にすれば
(* a + b must be less than 120 *)の注意書きも要らなくなると思う。
そうすれば+ord(cry)をそのまま+cryに出来るし。
191:デフォルトの名無しさん
06/04/12 12:14:53
>>189
cryって何ですか？
ほかにもコンパイルエラー出てるんですけど？
192:190
06/04/12 13:40:29
>>191
少しは自分で考えて。宣言がいくつか足りないのと、初期化やデータの
入出力をどうするのかは>>187に出ていないのでその部分は自分で書く
必要がある。
193:188
06/04/12 15:19:52
program Toi3(input,output);
var
i,n: integer;
f,z: array [0..1000] of integer;
function fibonacci(n : integer):integer;
begin
case n of
3..1000 : fibonacci:=fibonacci(n-1)+fibonacci(n-2);
1,2 : fibonacci:=1;
0 : fibonacci:=0
end; { case }
end;
begin
write('n=');
readln(n);
for i:=0 to n do
begin
f[i]:=fibonacci(i);
z[i]:=(f[n-1]-f[n-2])div(f[n]-f[n-1]);
writeln('f(',i:2,')=',f[i]:1,', ');
writeln();
writeln('z(',i:2,')=',z[i]:1,', ');
end;
end.
というのを作ったのですが、コンパイルはできるのに値を入力しても答えが出力されませんorz
194:188
06/04/12 15:20:31
program Toi3(input,output);
var
i,n: integer;
f,z: array [0..1000] of integer;
function fibonacci(n : integer):integer;
begin
case n of
3..1000 : fibonacci:=fibonacci(n-1)+fibonacci(n-2);
1,2 : fibonacci:=1;
0 : fibonacci:=0
end; { case }
end;
begin
write('n=');
readln(n);
for i:=0 to n do
begin
f[i]:=fibonacci(i);
z[i]:=(f[n-1]-f[n-2])div(f[n]-f[n-1]);
writeln('f(',i:2,')=',f[i]:1,', ');
writeln();
writeln('z(',i:2,')=',z[i]:1,', ');
end;
end.
というのを作ったのですが、コンパイルはできるのに値を入力しても答えが出力されませんorz
195:188
06/04/12 15:29:40
z[i]:=(f[n-1]-f[n-2])div(f[n]-f[n-1]);
は,
z[i]:=(f[i-1]-f[i-2])div(f[i]-f[i-1]);
の間違いです。
しかしまだ何かがおかしいらしい。
196:デフォルトの名無しさん
06/04/12 15:41:52
パスカルでおしえて大学生を抹殺するプログラムを作ろうと思いますが、
コメントの記念すべき一文字目は何にしようか迷ってます。
197:774RR
06/04/12 17:10:04
>190
そりゃそーなんだけど、キャリーはやっぱりフラグでしょw
>195
fibonacci関数は動くはずだから、それだけテストしてみるといい。
fibonacci(1)
fibonacci(2)
fibonacci(3)
と増やしていって、
fibonacci(100)の計算にどれだけ時間かがかかるか、ためしてごらん。
どうしてこんなに遅いのか、どうしたら効率良くできるのか。
そうすると for i:=0 to n do f[i]:=fibonacci(i); てのが
原理的には正しくても酷く悪いコーディングだと気付く。
それが勉強だよ。
198:デフォルトの名無しさん
06/04/12 17:17:40
俺は詳しくないからどうすればいいプログラムになるかというレベルではアドバイスできないんだけど
for文の中で"i"が"0"のときに
z[i]:=(f[i-1]-f[i-2])div(f[i]-f[i-1]);
というのは
z[0]:=(f[-1]-f[-2])div(f[0]-f[-1]);
ってことになってないかい？
あと整数型における"div"ってのは商を求める演算子であって
実数型における"/"とは違うってことは分かってる？
199:188
06/04/13 14:58:02
すっごい効率が悪いこととか、i=0のこととか、わかってるのですがどうすればいいのかがわからないすorz
200:デフォルトの名無しさん
06/04/13 15:50:10
3..1000 : fibonacci:=f[n-1]+f[n-2];
201:デフォルトの名無しさん
06/04/13 19:22:52
case文で、例えば「nの値が0の時は■、1の時は▲、2以上の時は●」としたいとき、
「2以上の時は●」のところはどうやって表記すればいいのですか？
case n of
0 : ■;
1 : ▲;
>=2 : ●;
とするとコンパイルエラーになってしまうのです（泣）
202:デフォルトの名無しさん
06/04/13 21:55:02
>>201
caseは順序型だから、下限、上限が決まっている。で、2からその上限まで
を指定すればいいってことになる。具体的には
case n of
0 : ■;
1 : ▲;
2..100 : ●;
とすればいい（上限値が100の場合）。
203:デフォルトの名無しさん
06/04/13 23:26:19
case n of
0 : ■;
1 : ▲;
else
if n >= 2 then
●;
end;
204:202
06/04/13 23:35:57
>>203
それ通らない処理系もある（というか標準Pascalだとcase節にelseは無い）。
205:デフォルトの名無しさん
06/04/13 23:42:30
caseのどの条件にも該当しなかったことを検出するにはどうすればいいのですか？
206:デフォルトの名無しさん
06/04/13 23:53:14
>>205
論理型変数を一つ用意して最初にfalseにしておく。
そのあとでcase文中の任意の条件にマッチした場合はtrueに変更してやる。
そうすれば該当しなかった場合はfalseのままだからfalseの場合なにかするっていうように
すれば一応できるんじゃない？
207:202
06/04/13 23:58:22
>>205
だからcase節の変数部（上記nの所）は順序型しか指定できないわけ
だから、上限、下限が決まっていて、個数も自ずと出てくるわけ。
だから「どの部分にも該当しなかった」という部分を抜き出すことも可能
でしょ。それをどこかで指定してやればいいわけ。例えば以下のような
感じで。
case n of
5 : ■;
8 : ▲;
15 : ●;
0..4, 6, 7, 9..14, 16..100 : ×; (* どの条件にも該当しない場合 *)
これは、nが0から100までの値を取る順序型の場合。範囲がそれ以外
の場合は適宜指定してやればいい。
208:デフォルトの名無しさん
06/04/14 06:54:53
pascal ha erai mendou na gengo desune.
209:201
06/04/14 16:04:04
>>202
上限がないから困っているわけでw
if文で書くしかないですかね？
210:デフォルトの名無しさん
06/04/14 17:00:59
if n >= 2 then
begin
●;
end else begin
case n of
0 : ■;
1 : ▲;
end;
じゃダメなのか？
211:188
06/04/14 17:06:52
フィボナッチを以下のように書き換えたのですが、確かに走るし100項でもすぐ出るんですが、マイナスの値がでてくるんです。なぜでしょうか？
program kadai14_2(input,output);
var
m,k : integer;
function fibonacci(n : integer):integer;
function fib(i,old,new : integer):integer;
begin
if i=n then
fib:=new
else
fib:=fib(i+1,new,old+new)
end; { fib }
begin
if n<=1 then
fibonacci:=n
else
fibonacci:=fib(1,0,1)
end; { fibonacci }
begin
writeln('数列の長さを入力してください');
readln(m);
for k:=1 to m do
begin
write(fibonacci(k):1);
write(',')
end;
writeln;
end.
212:デフォルトの名無しさん
06/04/14 17:42:07
>>211
整数がオーバーフローしてるんじゃないかと思われ。
213:188
06/04/14 17:50:53
>>212
詳しくお願いします！！
214:デフォルトの名無しさん
06/04/14 18:02:22
>>209
Pascalには上限のない順序型などない
215:デフォルトの名無しさん
06/04/14 20:15:52
>>213
何を詳しくお願いしてるんだ？
オーバーフローじゃないか？って言ってるじゃん。
216:212
06/04/15 00:33:08
>>213
integer が符号付き32ビットだったとすると、範囲は -2^31..2^31-1
つまり、-2147483648..2147483647。
フィボナッチ数列を計算してみると、
Fibonacci(45) = 1134903170
Fibonacci(46) = 1836311903
Fibonacci(47) = 2971215073 ←ここで32ビット版integerの範囲を超える
Fibonacci(48) = 4807526976
になるみたいなので、Fibonacci(47) 以降は値がおかしくなると思われ。
二進数で書くと、
. ↓このビットが1になると32ビット版 integer ではマイナスの値
Fibonacci(47) = 10110001000110010010010011100001
絶対値は
(100000000000000000000000000000000
- 10110001000110010010010011100001)
= (11111111111111111111111111111111
- 10110001000110010010010011100001) + 1
= 01001110111001101101101100011110 + 1
十進数に直すと
|Fibonacci(47)| = 1323752222 + 1 = 1323752223 ←これにマイナスがついた値になってしまう
URLﾘﾝｸ(www.edm2.com)
の Conclusion の手前に同じようなことが書いてある。(Cの例だけど)
217:212
06/04/15 00:36:57
数字がずれた…
> = (11111111111111111111111111111111
> - 10110001000110010010010011100001) + 1
> = 01001110111001101101101100011110 + 1
> 十進数に直すと
218:デフォルトの名無しさん
06/04/17 02:50:02
age
219:188
06/04/17 14:42:17
>>216
じゃあどうすればよいのですか？
220:774RR
06/04/17 18:17:43
多倍長整数演算るーちんをかく
221:デフォルトの名無しさん
06/04/17 18:59:09
必要なのは加算だけだから文字列のまま加算すればいい
文字列＋整数型の加算の例
function AddN(s:string;N:Integer):string;
var i,M:Integer;
var r:string;
procedure afunc;
begin
M:=((N mod 10)+10) mod 10;
r:=Char( ord('0') +M)+r;
N:=N-M;
N:=N div 10;
end;
begin
r:='';
for i := length(s) downto 1 do begin
N:=N+StrToInt(s[i]);
afunc;
end;
while N<>0 do begin
M:=((N mod 10)+10) mod 10;
afunc;
end;
Result:=r;
end;
文字列同士は、ループが３つ必要
222:デフォルトの名無しさん
06/04/17 21:00:09
function AddAB(a,b:string):string;
var i,j,N,M:Integer;
var r:string;
procedure afunc;
begin
M:=((N mod 10)+10) mod 10;
r:=Char( ord('0') +M)+r;
N:=N-M;
N:=N div 10;
end;
begin
r:='';
j:=length(b);
N:=0;
for i := length(a) downto 1 do begin
N:=N+StrToInt(a[i]);
if j>=1 then N:=N+StrToInt(b[j]);
afunc;
dec(j);
end;
for i := j downto 1 do begin
N:=N+StrToInt(b[i]);
afunc;
end;
while N<>0 do begin
M:=((N mod 10)+10) mod 10;
afunc;
end;
Result:=r;
end;
223:デフォルトの名無しさん
06/04/17 21:01:15
function fibonacci(n : string):string;
function fib(i,old,new : string):string;
begin
if i=n then
fib:=new
else
fib:=fib(AddN(i,1),new,AddAB(old,new))
end; { fib }
begin
if (length(n)<2) and(StrToInt(n)<=1) then
fibonacci:=n
else
fibonacci:=fib('1','0','1')
end; { fibonacci }
begin
for k := 1 to 100 do writeLn(k:5,':', fibonacci(IntToStr(k))) ;
224:デフォルトの名無しさん
06/04/18 03:29:41
>>189
まだ完成されていないみたいですが何が足りないのでしょうか？
４月からＰａｓｃａｌ始めたものですが・・・
225:デフォルトの名無しさん
06/04/18 03:32:26
>>187の問題のコト?
226:デフォルトの名無しさん
06/04/20 13:21:36
「名前」と「電話番号」をキーボードから入力すると、 それらのデータをUNIX上の ファイル 'teldata' に出力するプログラムを作成せよ。なお、 'teldata' に書き込まれた内容を全て表示させる手続きを加え、 完成したプログラムと実行例をつけて提出せよ。
ただし、1人当たりのデータの記憶にはレコード型を用い、 'teldata' はこのレコード型を成分とするファイルとすること。 また、データ入力の終了は「名前」として文字列 'end' を与えることで表現し、 入力可能なデータ数（人数）の上限は特に定めないこと。
この問題で
program kadai21(input , output , opfile);
type Kojindate = record
name : packed array [1..10] of char;
tel : packed array [1..15] of char;
end;
var opfile : file of Kojindate;
a : Kojindate;
begin
repeat
rewrite( opfile , 'intdate' );
writeln('名前：');
readln( a.name );
writeln('電話番号');
readln( a.tel);
write(opfile , a);
until a.name = 'end';
reset ( opfile , 'intdate' );
while not eof(opfile) do begin
repeat
read( opfile , a );
writeln( '名前：',a.name , '電話番号：' , a.tel);
until a.name = 'end'
end
end.
どこがまずいですかね？
227:デフォルトの名無しさん
06/04/20 13:23:31
それと
課題 2-1 では、 登録された電話番号データを全て出力した。 これを、 検索したい人の名前をキーボードから入力し、 対応する電話番号を答えるように変更せよ。
ただし、該当するデータが未登録の場合は検索に失敗したことを 通知するプログラムとすること。 （例えば「該当者なし」と表示するなど）
さらに、 名前として 'end' を入力するまで何回でも検索できるように拡張すると、 なお良い。
こいつお願いします。
228:デフォルトの名無しさん
06/04/20 18:00:09
キーボードから正の奇数を小さい順に入力し、 それらのデータをUNIX上の ファイル 'oddsequence' に書込む。
次に 正の偶数を同じく小さい順に入力し、ファイル 'evensequence' に 書込むプログラムを作れ。
更に、この二つのファイルの内容を合わせて、正の整数が小さい順に書込まれた ファイル 'sequence' を作り、その内容を全て表示するプログラム を作れ。
ただし、データは３、７、１３など、小さい値から入力すればよい。また、データ入力の 終了は 値 ０ を与えることで表現し、入力可能なデータ数の上限は特に定めないこと。
229:デフォルトの名無しさん
06/04/22 03:56:29
>>226多分こうだと思う。
Assign(opfile, 'teldata');
Rewrite(opfile);
repeat
writeln('名前：');
readln( a.name );
if a.name <> 'end' then begin
writeln('電話番号');
readln( a.tel);
write(opfile , a);
end;
until a.name = 'end';
Close(opfile);
230:デフォルトの名無しさん
06/04/22 04:16:37
>>227
procedure search;
var name : packed array [1..10] of char;
c : boolean;
begin
Readln(name);
while name <> 'end' do begin
Reset(opfile);
c := true;
while not eof(opfile) do begin
Read(opfile, a);
if a.name = name then begin
Writeln(a.tel);
c := false;
end;
end;
Close(opfile);
if c then Writeln('該当者なし');
Readln(name);
end;
end; { search }
231:デフォルトの名無しさん
06/04/22 05:04:10
>>228
program test1(input);
var o,e : file of integer; i:integer;begin
Assign(o,'oddsequence');Rewrite(o);
Read(i);while i <> 0 do begin Write(o,i); Read(i); end;
Assign(e,'evensequence');Rewrite(e);
Read(i);while i <> 0 do begin Write(e,i); Read(i); end;
Close(o);Close(e);end.
program test2(output);
var o,e,s : file of integer; i,j:integer;begin
Assign(o,'oddsequence');Reset(o);
Assign(e,'evensequence');Reset(e);
Assign(s,'sequence');Rewrite(s);i := 0; j := 0;
while not (eof(o) and eof(e) and (i = 0) and (j = 0)) do begin
if not eof(o) and (i = 0) then Read(o,i);
if not eof(e) and (j = 0) then Read(e,j);
if (i <> 0) and (i < j) then begin Write(s,i); i := 0;
end else if j <> 0 then begin Write(s,j); j := 0; end; end;
Reset(s); while not eof(s) do begin Read(s,i);Write(i);Write(' ');
end;Close(o);Close(e);Close(s);end.
232:デフォルトの名無しさん
06/04/22 17:02:18
はあ？
233:デフォルトの名無しさん
06/04/23 18:09:59
>>229
夜遅くにご苦労様です。
そこにif入れればよかったのか。
234:デフォルトの名無しさん
06/04/24 05:32:37
フィボナッチ数列の項は、その直前の連続する二つの項の和である。
f( n ) = f( n - 1 ) + f( n - 2 )
但し、 f(0) = 0, f(1) = 1 である。
フィボナッチ数列の連続する項の差の比
z = { f( n - 1 ) - f( n - 2 ) }/ { f( n ) - f( n - 1 ) }
は、 n が大きくなれば、ある値に収束する。この値の近似値を求める プログラムを書き、その値を示せ。この値は黄金分割比と呼ばれる。
フィボナッチ数列は関数 fibonacci を作って求め、項は配列に表せ。まず 30 項まで求め、黄金分割比の値が収束していく様子を出力して
確かめよ。収束判定のために定数 dif = 1.0 e -6 を宣言し、 連続する z の差の絶対値が dif 以下になったとき、
収束したとして計算を終了するプログラムを作り、プログラムとその 計算結果を提出せよ
235:デフォルトの名無しさん
06/04/24 05:34:47
コンパイルはできるんだけど、何かがおかしいです。
すみませんがわかる方教えてくれませんか？
program pe1_2(input,output);
const dif = 1.0e-6;
var i,m, g : integer;
f, z,q : array [0..500] of real;
function fibonacci(n: integer):integer;
begin
if (n >=0) and (n <=1) then fibonacci:=n
else fibonacci:=fibonacci(n-1)+fibonacci(n-2);
end; { fibonacci }
begin
f[i]:=fibonacci(i);
writeln('30項まで求めます ');
for i :=1 to 30 do
begin
writeln('f(',i:2,')=',f[i]:1);
end;
write('m=');
readln(m);
for i:= 3 to m do
repeat z[i]:=(f[i-1]-f[i-2])/(f[i]-f[i-1]);
until dif >= z[i]-z[i-1];
writeln(z[i]);
{writeln('z(',i:3,')=',z[i]:1,','); }
end.
236:デフォルトの名無しさん
06/04/24 06:10:31
こんな感じじゃないのか？
program pe1_2(input,output);
const
dif = 1.0e-6;
var
i : integer;
f,z : array [1..30] of real;
function fibonacci(n: integer):integer;
begin
if (n >=0) and (n <=1) then fibonacci:=n
else fibonacci:=fibonacci(n-1)+fibonacci(n-2);
end; { fibonacci }
begin
writeln('30項まで求めます');
for i :=1 to 30 do
begin
f[i]:=fibonacci(i);
writeln('f(',i:2,')=',f[i]:1);
end;
for i:= 3 to 30 do
begin
z[i]:=(f[i-1]-f[i-2])/(f[i]-f[i-1]);
writeln('z(',i:2,')=',z[i]);
if (i > 3) and (dif >= abs(z[i]-z[i-1])) then
break;
end;
end.
237:デフォルトの名無しさん
06/04/24 23:06:40
>>236
言われたとおりにしましたが前と同じ結果でした。
コンパイル結果
f(1)=0.0e+00
：
：
f(27)=0.0e+00
f(28)=0.0e+00
f(29)=0.0e+00
f(30)=0.0e+00
m=30
この後何も動きませんでした。
どこがおかしいのでしょうか？
わかる人教えてくれませんか？
238:デフォルトの名無しさん
06/04/24 23:28:52
if (n <=1) then fibonacci:=n
239:デフォルトの名無しさん
06/04/25 04:27:48
あんまり変わってないんじゃない？
240:デフォルトの名無しさん
06/04/25 06:56:08
⇒ if (n >=0) and (n <=1) then fibonacci:=n
＞但し、 f(0) = 0, f(1) = 1 である。
if (n <=1) then fibonacci:=1;
としても、ゼロになるというのは変だね
もしかして ちゃんとループさせてないんじゃないの？ >>236をそのまま実行させてないでしょ
それから integerのビット幅はいくら？ 16bitだとビット数が不足するよ
function fibonacci(n: real):real;
begin
if (n >=0) and (n <=1) then fibonacci:=1
else fibonacci:=fibonacci(n-1)+fibonacci(n-2);
end; { fibonacci }
begin
writeln('30項まで求めます');
for i :=1 to 30 do
begin
f[i]:=fibonacci(i);
writeln('f(',i:2,')=',f[i]:10:0);
end;
for i:= 3 to 30 do
begin
z[i]:=(f[i-1]-f[i-2])/(f[i]-f[i-1]);
writeln('z(',i:2,')=',z[i]);
if (i > 3) and (dif >= abs(z[i]-z[i-1])) then
break;
end;
end.
241:デフォルトの名無しさん
06/04/25 15:18:46
function fibonacci(n: integer):real;
242:デフォルトの名無しさん
06/04/26 23:23:49
program kadai(input , output);
type intri = ^real;
var ip : intri;
a : real;
begin
new( ip );
write( `値：` );
readln( a );
ip^ := a;
writeln( ip );
dispose( ip )
end.
簡単なやつなんですが実行しても入力した値そのままが出力せず、５桁の数字が出力してしまうという状況です。
ご指摘お願いします。
243:デフォルトの名無しさん
06/04/26 23:53:19
program kadai(input , output);
type intri = ^real;
var ip : intri;
a : real;
begin
new( ip );
write( '値: ' );
readln( a );
ip^ := a;
writeln( ip^ );
dispose( ip );
readln;
end.
244:デフォルトの名無しさん
06/04/29 21:58:58
>>243
ポインタをまだ理解しきれてなかったみたいです。
ありがとうございました。
245:デフォルトの名無しさん
06/05/04 16:37:24
本当に初歩的な質問なんですが…
x:=6*(1+3div2)mod5
とあったら、6×(1+1)÷5=2...2より、答えは2でいいんでしょうか？
また、m:=((x>z)and(y<z))
とあって、これはfalse and falseとなるんですが、
このあとは具体的にどうすればいいんでしょう？
ちなみにmは整数です。
助けていただければ幸いです…。
246:デフォルトの名無しさん
06/05/04 16:47:42
１、四則演算はカッコが最優先、乗除算がその次だからあってると思うよ
２、pascal は型に厳しいから 論理型を整数型に代入できないと思うのだが？
247:デフォルトの名無しさん
06/05/04 16:57:42
ご回答ありがとうございます。
最初は合ってましたか…よかった。
次なんですが（すいません書くならば正しくはfalse and trueでした）
mは整数、x,y,zは変数で、
具体的には m:=((2>10) and (5<10))
なんですが、これは…どうすればいいんでしょうか…。。。
248:デフォルトの名無しさん
06/05/04 17:05:19
申し訳ありません。見間違えていました…
mがbooleanでx,y,zが整数でした。本当にすいません…
そうしたら結局mはfalseということでよいのでしょうか？
249:デフォルトの名無しさん
06/05/04 18:25:24
and だから false だよね
250:デフォルトの名無しさん
06/05/04 21:24:02
どうもありがとうございました。そそっかしくてすいません…
251:デフォルトの名無しさん
06/05/11 19:39:47
２個の１次方程式が入力されたとき、その和を 出力するプログラムを作成しなさい。ただし、変数名はアルファベット１文字とし、 その係数値は整数１文字とせよ。
たとえば、2 x - 5 y を１文字ずつ入力（改行で区切る）し、ピリオド '.'が入力 されたならば、次の式、 - 9 y + 2 z を同じように入力する。プログラムはそれら の和、2 x - 14 y + 2 z を出力する。
252:モグラ介
06/05/11 19:49:23
すべてのパスワードを解読するプログラムがあったらすごい･･･
ありえないか。
253:デフォルトの名無しさん
06/05/11 20:03:30
すべてのって言うのが引っかかりますが、
総当りでやればいいんじゃないのか?
254:デフォルトの名無しさん
06/05/11 20:07:22
総当りならどんな難解なパスワードも必ず解析できるね。
何百年とか掛かるかもしれないけど。
255:デフォルトの名無しさん
06/05/11 21:00:59
まともなシステムなら連続で複数回間違えた時点でパスワードが無効になるような対策がなされているから無理
256:デフォルトの名無しさん
06/05/12 00:39:03
しばらくしたら正規のユーザーが管理者に申告して復活するでしょ
257:デフォルトの名無しさん
06/05/12 21:57:42
>>251 の答えまーだ？
258:デフォルトの名無しさん
06/05/13 00:35:23
キーボードからいくつもの「文字」を入力した時、各文字が何回入力されたかを結果として返すプログラムを、入力データの記憶にリスト構造を利用して作れ。なお、入力は１文字ずつ return で区切って入力し、その終了は '.' (ピリオド) で示すものとする。
と、
課題４ - １を参考にして、２個の１次方程式が入力されたとき、その和を出力するプログラムを作成しなさい。ただし、変数名はアルファベット１文字とし、その係数値は整数１文字とせよ。
たとえば、2 x - 5 y を１文字ずつ入力（改行で区切る）し、ピリオド '.'が入力されたならば、次の式、 - 9 y + 2 z を同じように入力する。プログラムはそれらの和、2 x - 14 y + 2 z を出力する。
２つの問題お願いします。
259:デフォルトの名無しさん
06/05/13 09:29:22
>>251
なんか良く判らんけど 適当に
{構造体の定義}
type TData=record c:char;a:Integer;next:Pointer;end;
type PData=^TData;
var root:PData;
{リストの印刷}
procedure writes;
var p:PData;
begin
p:=root;
while p<>nil do begin
if p^.a>0 then write('+');
write(p^.a,p^.c);
p:=p^.next;
end;
writeln;
end;
260:デフォルトの名無しさん
06/05/13 09:31:29
procedure func(s:string);
var w:TData;
var p:PData;
var sgn:-1..1;
var num:string;
begin
sgn:=1; w.next:=nil; num:='';
while s<>'' do begin
w.c:=s[1]; delete(s,1,1);
case w.c of
'+': begin sgn:= 1;num:=''; end;
'-': begin sgn:=-1;num:=''; end;
'0'..'9': begin
num:=num+w.c;
end;
'a'..'z','A'..'Z': begin
if num<>'' then w.a:=sgn*StrToInt(num) else w.a:=sgn;
p:=root;
while p<>nil do begin
if p^.c=w.c then begin p^.a:=p^.a+w.a; break; end;
p:=p^.next;
end;
if p=nil then begin w.next:=root; root:=@w; func(s); exit; end;
end;
'.': writes;
end;
end;
writes; readln(s); if s<>'' then func(s); {続けて処理するなら}
end;
261:デフォルトの名無しさん
06/05/13 09:33:13
なんか、改行が多すぎますが厄介だなあ
で、呼び出し部
var s:string;
begin
root:=nil;
readln(s);
func(s);
end;
素直に、ヒープか配列使った方がいいかもね
262:デフォルトの名無しさん
06/05/13 19:27:11
このコード提出した奴からは、動作説明させるからな
263:デフォルトの名無しさん
06/05/13 22:59:34
偽者はだまれ！自分独り占めにするな！
本物ならここに書き込まず裏で減点しているわ!
264:デフォルトの名無しさん
06/05/13 23:22:26
でも、単にメモリ確保の為にわざわざ再帰してるようなコードは、ちょっと目立つぞ
265:デフォルトの名無しさん
06/05/14 01:01:30
だれかエラトステネス篩について、具体例を交えながら分かりやすく解説してくれませんか？
もう訳が分かりません…
266:ミ,,ﾟДﾟﾐノ ◆A6VzDeLphI
06/05/14 01:24:54
エラトステネスの篩の概念は、次のようになります。
1 2 3 4 5 6 7 8 9 10 11 12 13 ...
このような数値列を用意して
まず最初の2は素数としてチェックして
2の倍数は素数じゃないから、フラグを立てます。
1 2 3 4 5 6 7 8 9 10 11 12 13 ...
O X X X X X
次に素数の可能性のある3は素数としてチェックして、
3の倍数はやはり素数じゃないから、フラグを立てます
1 2 3 4 5 6 7 8 9 10 11 12 13 ...
O X X X X X
O X X X
4にはすでに×がついているので、素数ではなく
次に素数だと思われる5は素数としてチェック。
5の倍数は素数ではないフラグを立てて…
1 2 3 4 5 6 7 8 9 10 11 12 13 ...
O X X X X X
O X X X
O X
と続けていくとチェックされていない所に
〇がつき、素数列が求まるという手法です。
267:ミ,,ﾟДﾟﾐノ ◆A6VzDeLphI
06/05/14 01:29:05
具体例を交えながらわかりやすく解説するほど
労力をかけたくないから、適当に勉強汁
URLﾘﾝｸ(www.google.com)
上記例では、1～13の箱を用意するために
Booleanの配列を定義して
1～13全部をTrueにしてから
4,6,8,10,12の箱をFalseにして、
6,9,12の箱をFalseにして、
という処理をする方法よ。
268:265
06/05/14 13:48:56
どうもありがとうございました。
プログラムで読んだ時、なにがtrueやfalseなのかがよく分からなかったんですが、
やっとなんとかわかりました。ありがとうございました。
269:269
06/05/20 16:27:59
キーボードからいくつもの「文字」を入力した時、 各文字が何回入力されたかを結果として返すプログラムを、 入力データの記憶に２分木を利用して作れ。 なお、入力の終了は '.' (ピリオド) で示すものとし、 結果はアルファベット順に出力するものとする。
を
program bi( input , output );
type tree = ^node;
node = record
moji : char; kaisu : integer; left , right : tree; end;
var p , head : tree; a : char;
procedure append(var t : tree; x : char );
begin
if t = nil then begin
new( t );
t^.moji := x;
t^.kaisu := 1;
t^.left := nil;
t^.right := nil
end
else if t^.moji = x then
t^.kaisu := t^.kaisu + 1
else if ord( t^.moji ) > ord( x ) then
append( t^.left , x )
else
append( t^.right , x )
end; { append }
270:269
06/05/20 16:28:56
procedure printl(t : tree );
begin
if t <> nil then begin
writeln( t^.moji , t^.kaisu );
printl( t^.left );
end
end; { printl }
procedure printr(t : tree );
begin
if t <> nil then begin
writeln( t^.moji , t^.kaisu );
printr( t^.right );
end
end; { printr }
begin
new( head );
new( p );
head := nil;
p := head;
repeat
write( '文字： ');
readln( a );
append( p , a )
until a = '.';
printl( head );
write( p^.moji , p^.kaisu );
printr( head );
dispose( head );
dispose( p )
end.
271:269
06/05/20 16:35:39
キーボードから「整数」を読込み、 入力データを２分探索木に書込め。 書き込んだ結果を出力せよ。 なお、整数は正または負のデータとし、入力の終了は '０' (ゼロ) で 示すものとする。同じ値が入力されることはないものとせよ。
を
program kadai5no2( input , output );
type tree = ^node; node = record kazu : integer; left , right : tree; end;
var p , root : tree; a : integer;
procedure data(var t : tree; x : integer );
begin
if t = nil then begin
new( t );
t^.kazu := x;
t^.left := nil;
t^.right := nil
end
else if t^.kazu > x then
data( t^.left , x )
else
data( t^.right , x )
end; { data }
procedure printl(t : tree );
begin
if t <> nil then begin
if t^.right <> nil then begin
write( t^.right );
printl( t^.right )
end
else begin
write( t^.kazu );
printl( t^.left )
end
end
end; { print }
272:269
06/05/20 16:36:48
begin
new( root );
new( p );
root := nil;
p := root;
repeat
write( ' 数： ');
readln( a );
data( p , a);
until a = 0;
printl( p );
dispose( p );
dispose( root )
end.
としたのですがどちらも出力をどうすればいいか分かりません。出力の他にも変なところがあれば指摘してくれると嬉しいです。
273:デフォルトの名無しさん
06/05/21 18:28:02
とりあえず上はそれだと白丸のところが出力されないはず
●
／＼
● ●
／| |＼
●
○ ○ ●
火曜提出でしょ？
もう少し悩んでみてもいいと思われ。
あと線形リストや二分木の先頭だけdisposeすると、
2番目以降は解放じゃなくて参照不可になるんじゃなかったっけ？
274:273
06/05/21 18:28:57
ウホッ、ずれまくったorz
275:デフォルトの名無しさん
06/05/23 18:55:46
キーボードから「英文」を読込み、空白（スペース）を英単語の 区切りと見做して、英単語辞書を整順リストの形式で作成するプログラム を作りなさい。
なお、入力の終了は '.' (ピリオド) で示すものとし、 同じ英単語が入力される場合は辞書に登録してはいけない。
a. 英文はアルファベット小文字のみの単語、スペース、ピリオドだけで 作られている場合を、まず考えよ。各単語の文字数は２０文字以内とせよ。
b. 次に、大文字が含まれる場合には、その文字を小文字に変換するよう に拡張せよ。
c. 最後に、数字、疑問符？、感嘆符！、クオート’、ダブルクオート"、 ハイフン-、コロン:、セミコロン；などの特殊文字が含まれている文 などを処理できれば完全である。
276:デフォルトの名無しさん
06/05/23 18:56:56
英単語辞書の問題において、 整順リストを２分木表現とするプログラムを作成せよ。
ポーランド記法で入力した四則演算式を２分木で表現し、 演算式の係数値を入力したときに、その計算結果を出力する プログラムを作れ。但し、演算式はアルファベット一文字の 変数と四則演算子のみで表現されている。
a.演算式が定数は含まない場合を考えよ。
b.整数の定数を含む場合に拡張せよ。
277:デフォルトの名無しさん
06/05/24 02:38:31
課題丸投げ早すぎｗ
278:デフォルトの名無しさん
06/05/24 22:20:26
>>277
そんな突っ込みより
答えキボンヌ。
279:デフォルトの名無しさん
06/05/25 20:51:54
電通大Ｃ科乙ｗ
280:デフォルトの名無しさん
06/05/25 22:08:22
>>279
去年につづきまたあそこか
馬鹿しかいないのか？
281:デフォルトの名無しさん
06/05/25 22:36:28
馬鹿が教えてるからしょうがない。
282:デフォルトの名無しさん
06/05/25 22:46:23
>>281
言えてる…。
283:デフォルトの名無しさん
06/05/26 02:25:45
>>278
ヒント
program database( input , output );
type a = ^b ; b = record c : packed array [1..20] of char ; d : a ;
var e, f : packed array [1..20] of char ;
bagin
readln(e);
readln(f);
if e < f then
begin writeln( e , f ); end else begin writeln( f , e ); end;
end.
２単語入力のみ対応
284:デフォルトの名無しさん
06/05/26 03:29:15
電通大生なんだが・・評判落とすような事はやめてくれ！
少しは考えろよ！！
言っておくが、これくらい普通に出来ないと後々の課題なんて出来ないぞ！
その時はまた写すのか？
お前それでいいのか？
次ページ最新レス表示スレッドの検索類似スレ一覧話題のニュースおまかせリスト▼オプションを表示暇つぶし2ch
5183日前に更新/280 KB
担当:undef