06/01/12 00:45:25
教育用（？）プログラムPascalの宿題をやって頂くスレ
■丸投げOK
■全く分かってない阿呆も放置しないで優しく対応
■他言語はよそ逝け( ﾟДﾟ)ｺﾞﾙｧ
■DelphiもTurbo Pascalも完全対応
【本家】
URLﾘﾝｸ(www.borland.co.jp)
【前スレ】
ｽﾚﾘﾝｸ(tech板)
【関連スレ】
くだすれDelphi（超初心者用）その１5
ｽﾚﾘﾝｸ(tech板)l50
Pascal の初心者用の質問・相談所
ｽﾚﾘﾝｸ(tech板)l50
【Delphi初心者】今から始めるDelphi Part01
ｽﾚﾘﾝｸ(tech板)l50
2:デフォルトの名無しさん
06/01/12 00:48:20
2getズサー
3:デフォルトの名無しさん
06/01/12 00:49:03
3getズザー
4:デフォルトの名無しさん
06/01/12 00:49:30
スレの趣旨に反するだろ
バカかお前
5:デフォルトの名無しさん
06/01/12 02:01:50
>前スレ978
URLﾘﾝｸ(kansai2channeler.hp.infoseek.co.jp)
今見たら49行目にいらんFormatが付いてたから消しといて。
6:taihenda
06/01/12 02:52:40
>5
ありがとうございます！！
Ｑ２を表示させるためにはどうしたらいいんですか？
すぐに実行画面が消えてしまいます。
7:デフォルトの名無しさん
06/01/12 03:52:59
>6
可能性1.コマンドプロンプト（通称DOS窓）が理解できていない。
可能性2.49行目をFormatだけで無く、全部消している。
まあ、想定内だが。
1.なら、コマンドプロンプトでググるか、以下の内容のテキストファイルを解凍したフォルダに作成して、Project1.batって名前に変更し、ダブルクリックするよろし。
Project1
pause.
2.なら元にもどしといて。
8:taihenda
06/01/12 04:41:43
>7
2でした。
お陰で完了しました。ありがとうございます。
何だか自分でももう一度組んでみようという気になれました☆
9:デフォルトの名無しさん
06/01/12 07:32:28
うはwwwwwこんなスレあったのかwwwww
10:デフォルトの名無しさん
06/01/12 22:06:13
age
11:デフォルトの名無しさん
06/01/13 09:04:08
自然数 N が与えられたとき、
1 から N までの数字を N 個並べる組み合わせをすべて
列挙するプログラムは Pascal で書くとどうなりますか？
例えば N = 3 のとき
1 2 3
1 3 2
2 1 3
2 3 1
3 1 2
3 2 1
となるようにです。
よろしくおながいします。
12:デフォルトの名無しさん
06/01/13 21:46:33
for counter=1 to N do
begin
for counter=1 to N do
begin
end;
end;
まずこれが思い浮かんだ。
13:12
06/01/13 21:47:16
修正。
for 1 to N do
begin
for counter=1 to N do
begin
end;
end;
14:デフォルトの名無しさん
06/01/13 21:48:26
for i := 1 to N do
for j := 1 to N do
begin
end;
だろ。
15:12
06/01/13 22:43:54
間違えた。
for counter1 := 1 to N do
begin
for counter2 := 1 to N do
begin
end;
end;
だった。
16:デフォルトの名無しさん
06/01/13 22:58:59
なにこのデジャヴ
17:12
06/01/14 00:10:11
はっ！！！人に見つかってしまった。
18:デフォルトの名無しさん
06/01/14 04:54:00
ここはアフォしかおらんのか
19:デフォルトの名無しさん
06/01/14 05:16:31
クオリティを求めるなら他言語スレ行ってください
CやJavaがお勧めです
20:デフォルトの名無しさん
06/01/14 05:26:26
>>18
うっさいボケ！自分もでけへんからひがんで荒らしてんのちゃうんか！
アホ↓↓
21:デフォルトの名無しさん
06/01/14 05:57:40
>>18
Pascal は教科書にしか出てこない研究用言語ですから
プロの実用に耐えません。
ここにいるのはアマチュア以下の人ばかりです。
22:デフォルトの名無しさん
06/01/14 06:06:16
今じゃPascal=Delphiみたいなもんだろ
objective-PascalとしてDelphiに上塗られて生きていくのさ
23:デフォルトの名無しさん
06/01/16 01:32:30
n個並べるなんて、階乗使って終わりだろ
24:デフォルトの名無しさん
06/01/16 12:32:34
>>23
個数がでるだけだろｗ
25:デフォルトの名無しさん
06/01/16 23:13:21
１～ｎをn個並べるのには何通りあるかってnの階乗で終わりじゃないのか？
1～nをｎ－1個並べるのには何通りあるかなら知らんけど
いや、nCn-1か
26:デフォルトの名無しさん
06/01/16 23:14:07
あぁ全部書き出すのか
忘れてくれwww
27:デフォルトの名無しさん
06/01/17 15:37:23
>>25,26
全部書き出されたかのチェックには良いかもしれない、と横からフォロー。
28:デフォルトの名無しさん
06/01/17 20:27:20
>21
本当のプログラマはPascalを使わない、ってのがあったな。
じゃあ何を使うのか? 21への宿題。
29:デフォルトの名無しさん
06/01/17 20:57:57
お前ら宿題やってやれｗ
誰もやらないから作ってみた↓
program test(input,output);
type
bb=array[1..100] of integer;
usee=array[1..100] of boolean;
var
b:bb;
use:usee;
n,i,p,count:integer;
begin
count:=0;
p:=0;
readln(n);
for i:=1 to n do
b[i]:=i;
for i:=1 to n do
use[i]:=false;
a(p,n,count,b,use);
end.
これに次のprocedureを付ければ多分使える↓
30:デフォルトの名無しさん
06/01/17 20:58:41
procedure a(p,x,count:integer;z:bb;m:usee);
var
i,l:integer;judge:boolean;
begin
count:=count+1;judge:=true;
for i:=1 to x do
begin
if m[i]=false then
begin
judge:=false;
end;end;
if judge=false then
begin
for i:=1 to x do
begin
if m[i]=false then
begin
z[count]:=i;
if count=x then
begin
for l:=1 to x do
write(z[l]);
end;
m[i]:=true;
a(i,x,count,z,m);
m[i]:=false;
end;end;end;
if count=x then
writeln;
end;
31:デフォルトの名無しさん
06/01/17 21:17:07
あと
>>Pascal は教科書にしか出てこない研究用言語ですから
>>プロの実用に耐えません。
>>ここにいるのはアマチュア以下の人ばかりです。
とか言ってるがpascalの宿題を書けなかったら
javaやC言語やdelhiでも書けるわけないだろｗ
結局はCUI仕様をGUI仕様にしただけだし
32:デフォルトの名無しさん
06/01/18 04:06:51
俺もpascalは使えるけどdelhiは無理。
33:デフォルトの名無しさん
06/01/18 16:38:43
よく分からないけどDelphiでグラフィックが動くプログラム誰か作ってくらはい。
線が移動しながら伸び縮むするとか、多角形とかダイヤみたいなマークが移動するだけのでもいいです。
34:デフォルトの名無しさん
06/01/18 17:14:03
>>33
必要としているのなら、必要としている人が作るのが一番。人に依頼する
のなら、それなりの対価としっかりした仕様書を出さないと相手にされない。
35:774RR
06/01/18 17:38:45
テスト墨。MaxNplus1はMaxNより1大きい数ね。TP懸かってるから、
標準Pにしてちょ。
Program Enjoy2chtest;
const MaxNplus1 = 5; MaxN = 4;
type
range = 1..MaxNplus1;
range0 = 0..MaxNplus1;
using = set of range;
var
data : array[range] of range0;
use : using;
procedure initialise;
var i : range;
begin
use := [];
for i := 1 to MaxNplus1 do data[i] := 0
end;
procedure display;
var i : range;
begin
for i := 1 to MaxN do write(data[i] : 4);
writeln
end;
36:774RR
06/01/18 17:39:59
これが都筑。部分反鋳型、習合型、再帰予備出といろいろ浸かってる。番兵定石もね。
procedure add(idx : range0);
var ii : range0;
begin
if idx = MaxNplus1 then display
else begin
while data[idx] < MaxNplus1 do begin
ii := data[idx];
repeat ii := succ(ii) until not (ii in use);
data[idx] := ii;
if ii < MaxNplus1 then begin
use := use + [ii];
add(succ(idx));
use := use - [ii]
end
end;
data[idx] := 0
end
end;
begin
initialise;
add(1)
end.
37:774RR
06/01/18 17:41:40
あ、これは>>11のχね。MaxN以下の任意の数に制限しても動作するけど、
その改造くらいはやってみよー
38:774RR
06/01/18 17:47:35
>28の宿題どうなった? >>21
まあ、永遠不滅の漢の言語だな、あれは。
39:デフォルトの名無しさん
06/01/18 20:22:49
initialise;
とinitialiseのprocedureなしでも作動した
あと>>11の宿題は>>29にもあるぞー
40:デフォルトの名無しさん
06/01/19 06:30:46
>initialise
sかよｗ
41:デフォルトの名無しさん
06/01/19 09:37:54
パスカルだからフランス語にしたんだろう。
42:774RR
06/01/19 12:40:06
>40
Que si?
普通の英語だおー
>39
処理系によっては、メモリ領域をOSから貰う時にゼロフィルするのがあるの。
43:& ◆D3ra0B2LiQ
06/01/19 23:14:18
すいません電卓のプログラミングの宿題が出ました
負数も扱えるようにしたいのですがどこに追加したらよろしいのでしょうか
下に与えられたものをすべて書きます
program calc(input, output);
var
NULLTOKEN: char; {文字がないことを表す文字コード}
CurrentToken: char; {現在処理中の字句}
result: integer; {値を評価した結果}
error: Boolean; {エラーが生じたことを示す論理型変数}
procedure GetToken; {字句があれば1字句読みこむ手続き}
var
ch: char;
begin
if eoln(input) then
CurrentToken := NULLTOKEN
else
begin
read(ch);
if ((ord('0') <= ord(ch)) and (ord(ch) <= ord('9')))
or (ch = '+') or (ch = '-') or (ch = '*') or (ch = '/')
or (ch = '(') or (ch = ')') then {読み込んだchが字句ならば,}
CurrentToken := ch {CurrentTokenにいれる.}
else
begin {そうでなければ, エラー.}
error := TRUE;
writeln('Not a token.')
end
end
end;
44:43
06/01/19 23:18:36
program calc(input, output);
var
NULLTOKEN: char; {文字がないことを表す文字コード}
CurrentToken: char; {現在処理中の字句}
result: integer; {値を評価した結果}
error: Boolean; {エラーが生じたことを示す論理型変数}
procedure GetToken; {字句があれば1字句読みこむ手続き}
var
ch: char;
begin
if eoln(input) then
CurrentToken := NULLTOKEN
else
begin
read(ch);
if ((ord('0') <= ord(ch)) and (ord(ch) <= ord('9')))
or (ch = '+') or (ch = '-') or (ch = '*') or (ch = '/')
or (ch = '(') or (ch = ')') then {読み込んだchが字句ならば,}
CurrentToken := ch {CurrentTokenにいれる.}
else
begin {そうでなければ, エラー.}
error := TRUE;
writeln('Not a token.')
end
end
end;
;
45:43
06/01/19 23:20:58
function expr: integer; {<式>を評価する関数}
var value: integer;
function term: integer; {<項>を評価する関数}
var value: integer;
function factor: integer; {<因子>を評価する関数}
var value: integer;
function digit: integer; {<数字>を評価する関数}
begin
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;
46:43
06/01/19 23:22:37
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 := digit { その因子は<数字>として評価.}
end;
begin {term}
value := factor; { <項> のはじめにあるはずの<因子>を評価する.}
while (CurrentToken = '*') or (CurrentToken = '/') do {その後, <乗除演算子>が}
case CurrentToken of {あるかぎり,<乗除演算子><因子>の繰り返し}
'*':
begin {として評価する.}
GetToken;
value := value * factor
end;
'/':
begin
GetToken;
value := value div factor
end end; term := value end;
47:43
06/01/19 23:23:38
begin {expr}
value := term; { <式> のはじめにあるはずの<項>を評価する.}
while (CurrentToken = '+') or (CurrentToken = '-') do {その後, <加減演算子>が }
case CurrentToken of {あるかぎり, <加減演算子><項>の繰り返し}
'+':
begin {として評価する.}
GetToken;
value := value + term
end;
'-':
begin
GetToken;
value := value - term
end end; expr := value end;
48:43
06/01/19 23:24:24
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.
49:デフォルトの名無しさん
06/01/20 08:31:13
とりあえず
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
06/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
06/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;
52:デフォルトの名無しさん
06/01/21 00:22:19
これじゃ駄目？
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;
53:43
06/01/21 22:47:29
たぶんできると思います。
学校じゃないとできないんで月曜日試してみます。
ありがとうございました。
54:デフォルトの名無しさん
06/01/23 05:22:35
二つの変数の値を交換する手続きを作成する。
２数を変数渡しにしたswap１(var a,b:real)
２数を値渡しにしたswap２(a,b:real)
簡単ですよね。
55:デフォルトの名無しさん
06/01/23 05:30:09
簡単ですね。
56:デフォルトの名無しさん
06/01/23 06:08:19
簡単すぎてヘドが出ますね。
57:デフォルトの名無しさん
06/01/23 09:49:36
値渡しはわかるが変数渡しはわからないな。
まあ俺も始めたばかりのど素人だけどな。
58:デフォルトの名無しさん
06/01/23 11:18:36
>>57
５分勉強してください＾＾
59:デフォルトの名無しさん
06/01/23 11:39:05
値渡しでは交換のしようがないと思うのだが。
60:デフォルトの名無しさん
06/01/23 16:09:19
練習なんだからいいんだろ
61:デフォルトの名無しさん
06/01/23 16:36:52
z:=a;
a:=b;
b:=z;
これでいいか？ｗ
62:デフォルトの名無しさん
06/01/23 17:17:03
わかりました。ありがとうございます。
63:デフォルトの名無しさん
06/01/24 17:50:27
デルフィです。正多角形の頂点をすべて結んでダイアモンドパターンを描くプログラムらしいんですが、動きません。
どうやったら動きますか。修正していただけるとうれしいです。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
64:デフォルトの名無しさん
06/01/24 17:51:28
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;
65:デフォルトの名無しさん
06/01/24 17:59:53
>>63
xe := x0 + round(r*cos(t+j));
ye := y0 + round(r*sin(t+j));
ではなく
xe := x0 + round(r*cos(t*j));
ye := y0 + round(r*sin(t*j));
じゃね？
66:デフォルトの名無しさん
06/01/24 18:47:56
>>65
ありがとうございます。教科書を再確認したらちょうどそこで間違えてました。
だけど、いまだにvarの直後にカーソルが来てエラーが出るんですが
どこがまだ間違ってるとおもいますか？
＞[エラー]Unit1.pas(31):';'が必要な場所に’VAR’があります
＞[エラー]Unit1.pas(51):宣言が必要な場所にファイルの末尾があります
＞[致命的エラー]Project2.dpr(5):'Unit1.pas'ユニットはコンパイルできませんでした
って言うエラーメッセージが出てきます
67:774RR
06/01/24 18:50:14
procedure dia(x0,y0,r,n:integer) ;←
68:デフォルトの名無しさん
06/01/24 18:58:26
>>67
ありがとうございます！
こんな簡単なことでつまづいてたなんて恥ずかしいです。
69:ささ ◆6KVcpBNXy.
06/01/27 01:44:14
パスカルの宿題がわかりません。どうやってつくったらいいかも…
こっちに誘導されてきました…↓下記にカキコあります↓
ｽﾚﾘﾝｸ(tech板:965-番)
お願いします
70:デフォルトの名無しさん
06/01/27 02:21:23
>>69
まずは平均点を求めるための式を考えてみましょう
71:デフォルトの名無しさん
06/01/27 02:28:33
なんかバカにしてるみたいなこと書いてしまったけど、
レスくれたらちゃんと答えに導くつもりなので
72:デフォルトの名無しさん
06/01/27 03:12:52
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.
06/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.
06/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.
秋学期試験前に難しい宿題出て四苦八苦してます
75:デフォルトの名無しさん
06/01/27 21:08:45
ひとりの３教科の点数を一度にくれてやったらだめなのか
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;
readln;
end.
76:ささ ◆6KVcpBNXy.
06/01/28 00:50:20
回答ありがとうございます。
constって習っていません
formatがDelphi６では未定義となります。
これだと終了しないのでは？。。
77:デフォルトの名無しさん
06/01/28 05:59:41
>>76
const は定数で、リードオンリー。
format が未定義と出るのは、uses に SysUtils ユニットが入ってないからと思われ。
78:ささ ◆6KVcpBNXy.
06/01/28 13:03:27
返答ありがとうございます。
formatと%dの意味がわかりません。
もしn人目の三科目の平均を表示するなら下記でよろしいですか？
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];
heikin= sum1/3;
writeln(Format('%d人目の合計点は%d点', [i+1, Sum1]));
writeln(Format('%d人目の平均点は%d点',[i+1,heikin]));
end;
%.4fとはどういう意味ですか？
小数点以下が４桁も表示されるので表示しないようにしたいのですが…
'%.4f点です', [Sum2]));
79:デフォルトの名無しさん
06/01/28 13:21:35
ヘルプを見ずに質問するのがこのスレの流儀です。
80:デフォルトの名無しさん
06/01/28 13:25:18
むしろヘルプをみるとすぐに答えが分かってしまうため、ヘルプを見るのは御法度です。
81:ささ ◆6KVcpBNXy.
06/01/28 14:28:52
>>79-80ヘルプに載っていたのですね。安易に質問してすいません。
もしn人目の三科目の平均を表示するなら下記でよろしいですか？
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];
heikin= sum1 / 3;
writeln(Format('%d人目の合計点は%d点', [i+1, Sum1]));
writeln(Format('%d人目の平均点は%d点',[i+1,heikin]));
82:75
06/01/28 16:10:47
>>78
わかんないんならムリに Format を使う必要ないだろう
ただ単に文字列の体裁を整えているだけなので、これは IntToStr 等に置き換えられる。
writeln(IntToStr(i+1)+'人目の合計点は'+IntToStr(Sum1)+'点');
>>81
n人目なら i じゃなくて n だけどな
小数点以下を必要としないときは３で割る部分を
var
heikin: Integer; //整数型で充分
begin
heikin := Sum1 div 3;
などとする。こうすると整数の割り算になるから小数点以下は捨てられる。
こういう総論的なことは教科書が手元にあるんだったら載ってるはずだから確認してみれ
つか試験とか大丈夫なのか？
83:ささ ◆6KVcpBNXy.
06/01/28 16:38:49
>>82返答ありがとうございます。できました！
大学秋試験は大丈夫ですよ～ノートとかきっちりとってますので。。。
ありがとうございました。
84:デフォルトの名無しさん
06/01/28 16:45:56
>>82
> writeln(IntToStr(i+1)+'人目の合計点は'+IntToStr(Sum1)+'点');
何故
writeln(i+1, '人目の合計点は', Sum1, '点');
と書かないの？
85:75
06/01/28 16:48:45
>>84
えーだってこっちのほうが分かりいいと思って
引数の数が不定のFormatがわかんないっていうし
86:デフォルトの名無しさん
06/01/28 23:15:49
「フィボナッチ数列を生成するプログラムを、再帰呼び出しを使って作成したい。数列の長さを入力させ、その長さの結果を出力するように、プログラムしなさい。
フィボナッチ数列は、1 , 1 , 2 , 3 , 5 , 8 , 13 , 21 , … のような数列である。」
という問題です。
私は以下のようなプログラムを作りました。いちおう実行できるのですが、もっと簡潔な美しいプログラムが書けるのでしたら教えてくださると助かります。
よろしくお願いします。
program fibonacci(input,output);
var i,n : integer;
function fibonacci(n : integer):integer;
begin
if n>=3 then
begin
fibonacci:=fibonacci(n-1)+fibonacci(n-2)
end
else
begin
fibonacci:=1
end
end; { fibonacci }
begin
writeln('数列の長さを入力してください');
readln(n);
for i:=1 to n do
begin
write(fibonacci(i):3,', ')
end;
writeln;
end.
87:86
06/01/28 23:22:30
連続ですいません。こちらもよろしくお願いします。
「2個の整数値の最大公約数を計算するアルゴリズムを使って、n個の整数値を入力し、それらの最大公約数を出力するプログラムを
再帰呼び出しの形式で作れ。ただし、入力は最大10個までとし、値を0読み込む前までの正の整数を入力値とする。」
という問題です。
再帰呼び出しを使わないプログラムは以下のように書けたのですが、これをどう変換すればいいのかがわからなくて、、、orz
program gcd(input,output);
var p,q,n : integer;
function gcd(a,b: integer ):integer;
var tmp : integer ;
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
06/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
06/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.
複文を変えた程度で、ほとんどいじる所がない。
誰でも同じように書ける言語つーのがPascalつーか�hぃると先生の流儀。
90:774RR
06/01/28 23:26:27
>87
AとBとCとのGCDは
(AとBとのGCD)とCとのGCD、って発想かと。
末尾再帰になりそうだから、ループに展開するのが普通じゃないかな。
（書いてみてないのでぼそっと）
91:デフォルトの名無しさん
06/01/28 23:35:25
function gcd(a, b: integer): integer;
begin
if b = 0 then gcd := a
else gcd := gcd(b, a mod b)
end;
92:86
06/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.
93:86
06/01/28 23:55:01
（上のつづき）としたら、実行結果が
1番目の値を入力
10
1番目の値を入力
20
1番目の値を入力
30
1番目の値を入力
40
1番目の値を入力
50
1番目の値を入力
60
1番目の値を入力
70
1番目の値を入力
80
1番目の値を入力
0
最大公約数は 80
･･･orz
94:デフォルトの名無しさん
06/01/29 05:29:24
64の図形をウィンドウの端まで行くと、入射角＝反射角で跳ね返る
っていうのを繰り返すように組むことってできますか？
例えばボタン１で図形が現われて、ボタン２で上記の動きを始めるみたいな・・・
95:デフォルトの名無しさん
06/01/29 15:36:24
3桁の整数を入力し、その英語読みを出力するようなプログラム
ってどう書くんですかまったくわかりませんorz
96:デフォルトの名無しさん
06/01/29 21:49:13
>>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.
97:デフォルトの名無しさん
06/01/29 22:08:46
>>95
とりあえず作ってみた。
URLﾘﾝｸ(www.uploda.org)
pass:pascal
98:デフォルトの名無しさん
06/01/29 22:25:09
>>97
自己レス。
TOneToNine = 0..9; ←型名と範囲がずれているけど、細かいことは気にしてはいけない
TTwoTo99 = 0..99; ←型名と範囲がずれているのは、直すのを忘れたから
・DelphiとFreePascalでコンパイルできると思う。
・できたプログラムを実行すると、プログラムと同じディレクトリにある
"hoeee.txt"を上書きしてしまう。ソースを読めばわかるだろうけど、一応注意ってことで。
99:デフォルトの名無しさん
06/01/29 22:49:15
>>95, >>96
ありがとうございます！！(感涙)
>>87のほうも是非お願いします！！
100:デフォルトの名無しさん
06/01/29 22:53:06
100
101:デフォルトの名無しさん
06/01/29 23:03:23
>>99
program g(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
answer:=gcd(answer,x);
i:=i+1
end;
until (i>10) or (x=0);
writeln('最大公約数は',answer:3);
readln;
end.
102:デフォルトの名無しさん
06/01/30 00:26:02
>>101
禿しくサンクスです！！
ありがたく拝見させていただいて学習します。
103:デフォルトの名無しさん
06/01/30 20:38:06
お、こんなとこで同級生ﾊｹｰﾝ。
ガンガレ。
104:デフォルトの名無しさん
06/01/31 14:08:43
＞PASCALの宿題は俺にやらせろ！！
やらせはせんよ！
105:デフォルトの名無しさん
06/02/05 02:10:49
入力された値を大きい順に並べて出力するプログラムのつもりで作りました。
０で入力停止のはずなのに止まらないし、なんか変な結果が出ます。
どこに問題があるのでしょうか？？
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:デフォルトの名無しさん
06/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.
107:デフォルトの名無しさん
06/02/05 03:08:37
>>105
procedure swap(var a, b: integer); (* var で書き換え可能にする *)
var
tmp : integer;
begin
(* readln(a,b); これは必要ない *)
if a<b then
：
：
108:デフォルトの名無しさん
06/02/05 12:10:58
５次元のベクトル A と B のデータを読み込み、それらの和ベクトル C とそれらの内積の値 D を求めて出力するプログラムを作れ。
ベクトルの要素のデータ型は、整数、実数のどちらかに統一しなさい。データはキーボードから読み込むものとする。また、 writeln を用いて、データの型、入力のさせ方をメッセージの形で記述せよ。
これお願いします。
なんか俺プログラミングの教材読んでもとりあえず理解できたけど問題出されると解けないんですが、これってもうそっち方面の考える力がないんですかねえ。
他の理系科目は普通にこなせるんですが、離散もできないし。
数こなせば出来るようになんの？
109:デフォルトの名無しさん
06/02/05 18:36:30
ベクトルと内積というのがよくわからん・・・
数学的問題は基本的に苦手だが
とりあえず5次元だから
Data:array[1..n][1..n][1..n][1..n][1..n] of real;
型ってことか・・・？（笑）
AとB読み込んでA+BをCに入れて内積の計算 |a|*|b|*cosθ をDに入れて出力するだけなら
Data:array[1..4] of real;
でいいと思う
writeln('Aの入力');
readln(Data[1]);
writen('Bの入力');
readln(Data[2]):
Data[3]:=Data[1]+Data[2];
Data[4]:=ABS(Data[1])*ABS(Data[2])*COS(θ）;
writeln('和ベクトル',Data[3]);
writeln('内積の値',Data[4]);
みたいな感じかな・・？
数学得意じゃないのでいまいちわからんからあとはがんばれ
110:デフォルトの名無しさん
06/02/05 20:19:47
>>108
とりあえず作ってみた。
URLﾘﾝｸ(www.uploda.org)
・入力のエラーチェックはしていない。
・ FiveVector1→A
FiveVector2→B
FiveVectorSum→C
hoeee→D
という対応になってるんで、必要ならテキスト置換でも使って変換してくだちい。
111:デフォルトの名無しさん
06/02/05 20:21:21
111
112:105
06/02/05 21:19:38
>>107
ありがとうございます。ご指摘の通り直したら動きました。
ところで
procedure swap(var a, b: integer); (* var で書き換え可能にする *)
とありますが、varをつけるとプログラム本文のところで別の文字を使って使える
ということですか？
なんか実引数とか仮引数とかがわかってないことを見せつける質問ですいませんorz
113:デフォルトの名無しさん
06/02/06 02:31:16
ハローパスカル始めることにしたから、よろしく。
114:デフォルトの名無しさん
06/02/06 18:53:02
>>112
program none(output);
var a,b:integer;
procedure add(var a,b:integer);
begin
a := a + 1;
b := a + 2;
end;
begin
a:=2;
b:=3;
add(a,b);
writeln(a,b:2);
end.
ってしたら最終的にaが3で、bが5になってる。
procedure add(a,b:integer);
だったらadd(a,b)が実行されても値は変化しない。つまりaが2で、bが3。
115:デフォルトの名無しさん
06/02/06 19:09:04
それにしても暇だ。
大学一年生にもできそうでちょっと難しいような宿題が投下されないだろうか。
116:774RR
06/02/06 19:31:50
>115
じゃあCASLのアセンブラと仮装機械w
117:デフォルトの名無しさん
06/02/06 19:50:04
㌧
最初見たとき言葉遣いとhoeeeにうけましたｗ
118:115
06/02/06 22:56:00
>>116
調子こいてました（＞＜
でも単純に機械語に翻訳するだけならなんとかなるのだろうか。
そこからプログラムを動かすってのが明らかに不可能です
本当にありがとうございました。
119:デフォルトの名無しさん
06/02/07 02:24:54
みんなのところもポインタで逆ポーランドの電卓つくるのがゴールかな？
120:デフォルトの名無しさん
06/02/07 05:03:24
>>119
は？バカ？
121:デフォルトの名無しさん
06/02/07 05:33:32
>>119
え？このスレってそんなレベル？
122:デフォルトの名無しさん
06/02/07 08:50:04
逆ポーランドってなんだ？
123:デフォルトの名無しさん
06/02/07 09:51:23
あっはっはっはｗ
124:774RR
06/02/07 12:16:18
逆ポーランドなつかすいな。
HPの電卓もかっこよかたな。
1 ENTER 2 + 3 * 4 - ....
125:デフォルトの名無しさん
06/02/07 13:29:25
ポインタをつかって逆ポーランドの電卓をつくってください。
識者の方どうかおねがいします（＞＜）
126:デフォルトの名無しさん
06/02/07 17:59:15
電卓って？標準入力で入力していいのか？
127:774RR
06/02/07 18:34:57
手抜きで標準入力、文字列から数への変換も手抜きだ。
TP互換環境なら走るだろう。その壱
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;
128:774RR
06/02/07 18:36:15
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;
procedure calc(opr : char);
var r1, r2 : real;
begin
pop(r2);
pop(r1);
case opr of
'+' : r2 := r1 + r2;
'-' : r2 := r1 - r2;
'*' : r2 := r1 * r2;
'/' : r2 := r1 / r2
end;
push(r2)
end;
129:774RR
06/02/07 18:38:30
procedure disp;
begin
if stack<>nil then writeln('>>', stack^.data)
else writeln('Stack underrun.')
end;
procedure initstack;
begin
new(stack);
stack^.data := 0;
stack^.next := nil
end;
procedure allclear;
var s : pstack;
begin
while stack<>nil do begin
s := stack.next;
dispose(stack);
stack := s
end;
initstack
end;
130:774RR
06/02/07 18:39:31
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.
131:774RR
06/02/07 18:43:26
1
2
+
3
4
+
*
...
って感じに入力していくと逆ポな計算機になるよ。
スタックを線形リストで表現してるのが一応演習課題に則ってる。
本当なら、文字列→数の変換もスタックを使うんだが、めんどい。
そこまですると、電卓の+/-キー（符号反転キー）が二項演算子の-キーと
分かれている理由がよく理解できる。
132:デフォルトの名無しさん
06/02/07 18:44:36
procedure allclear;
var s : pstack;
begin
while stack<>nil do begin
s := stack.next;
dispose(stack);
stack := s
end;
initstack
end;
s := stack.next;
じゃなくて
s := stack^.next;
じゃない？
133:774RR
06/02/07 18:45:30
いけねえ、最初のconstは見なかった事にしてくれ。
前回投稿した消し残りだw
134:774RR
06/02/07 18:47:19
>132
その通りだけど、何でコンパイルできたんだろうw
拡張構文なのかコンパイラのバグかww
135:デフォルトの名無しさん
06/02/07 22:56:20
めちゃくちゃ初心者なのですが・・・。
問題聞いてもらってもよろしいでしょうか？
136:135
06/02/07 23:04:50
一応問題を書かせて頂きます。
1 一方向リストの中のp番目とNEXT(p)番目の位置の要素を交換するプログラムを
手続きを用いて書け。
関数NEXTの定義：リストLで位置pの直後の位置を返す関数
とありますが、NEXTという関数はPascalに標準であるのでしょうか？
私の使っているCPad for free pascalだとないと言われるのですが・・。
137:デフォルトの名無しさん
06/02/07 23:53:23
無いんじゃない？
138:デフォルトの名無しさん
06/02/07 23:57:04
>>137 ですよね・・。
ということは、自分でNEXT関数を自分で定義しろということですか？
139:デフォルトの名無しさん
06/02/08 00:02:10
いや、俺もそんな詳しくないけど聞いたことはないよね。
一方向リストってどういう構造なん？
ポインタで繋いでるなら別段難しいことはないと思うんだけど。
140:デフォルトの名無しさん
06/02/08 00:05:31
>>139
ポインタを使ったリスト構造のことだと思います。
141:デフォルトの名無しさん
06/02/08 00:16:52
type
list = ^listcell
listcell = record
e : element;
point : listCell;
end;
var
p : list;
みたいな感じに定義してlistcell型の要素が繋がってるんなら、たとえばp^.pointが
pの要素の次の位置を指しているんじゃないの？
なんだかいまいち俺には分からないんだ。
問題を全部書いてくれれば分かるかもしれない。
あれで全部？
142:デフォルトの名無しさん
06/02/08 00:24:02
双方向じゃないやつだな＜一方向
143:デフォルトの名無しさん
06/02/08 00:27:39
えっと、あれで全部です・・・。
e:elementってelementってどういう変数か知りませんが、要素って
名前とかじゃだめですかね？
type
list=^listcell
listcell=record
name:string[10];
id:integer;
pointer:list
end;
var init,current:list;
datname,datid:string[10];
こんな感じでもいいかな？
144:デフォルトの名無しさん
06/02/08 00:28:28
>>142
じゃあ、ポインタとはまた違うものだってことでしょうか？
まったく習っていないのでわかりません。
145:デフォルトの名無しさん
06/02/08 00:29:32
type
list=^listcell
listcell=record
name:string[10];
id:integer;
pointer:list
end;
var init,current:list;
datname:string[10];
datid:integer;
に訂正
146:141
06/02/08 00:40:57
そっから
new(init);
new(current);
init^pointer := current;
みたいな感じで繋げていくんだよな？
そのあと値を入れていったとする。
>1 一方向リストの中のp番目とNEXT(p)番目の位置の要素を交換するプログラムを
>手続きを用いて書け。
>関数NEXTの定義：リストLで位置pの直後の位置を返す関数
ってことだけど、例えばp=１番目の直後の位置ってのはこの例でいくと
init^.pointerが指してるもののことじゃないの？
あと交換するだけなら要素の内容をレコード型変数かなにかに一旦格納して
入れ替えればいいんじゃないかと思うんだけど、どのあたりを俺は勘違いしているのか。
147:デフォルトの名無しさん
06/02/08 00:48:50
>>146
> そっから
> new(init);
> new(current);
> init^pointer := current;
> みたいな感じで繋げていくんだよな？
> そのあと値を入れていったとする。
この部分はわかります。
next関数に関してですが、p=1の場合と最後の時、それから途中の場合で
場合わけしなければいけないと思うのですが、
入れ替える位置というのが名前とか、idだとできると思うんですがこの問題の場合
p番目といわれるとわかりません・・・。
148:デフォルトの名無しさん
06/02/08 00:51:39
あ、while current^.pointer <> nil do begin
でまわしてるときに、
n:=n+1していけばいいのかな？
149:141
06/02/08 00:59:43
n := n + 1;
でいいだろうね。
それとnext関数を最初と最後で場合わけしないといけないってことだけど、
最初と最後になにも入ってないダミーセルを配置しておけば例外処理を
行わなくてもできるんじゃない？
つまり実際に値を格納しておくものよりも二つぶん多めにnewしとく。
150:デフォルトの名無しさん
06/02/08 01:19:17
>>149
ダミーセルをつくるのはたぶんだめっていわれます。
151:デフォルトの名無しさん
06/02/08 01:57:34
とりあえず、リストの作成と書き出しをやってみましたが、終了条件を'end'にしているのに
endで終わらない・・・。
var init,current:list;
datname:string[10];
datid:integer;
begin
new(init);
current:=init;
write('名前を入力してください'); readln(datname);
write('IDを入力してください'); readln(datid);
while datname <> 'end' do begin
current^.name:=datname;
current^.id:=datid;
new(current^.pointer);
current:=current^.pointer;
write('名前を入力してください: '); readln(datname);
write('IDを入力してください： '); readln(datid);
end;
current^.pointer:=nil;
{リストの書き出し}
current:=init;
while current^.pointer <> nil do begin
write(current^.name,' ',current^.id);
current:=current^.pointer
end;
writeln
end.
152:デフォルトの名無しさん
06/02/08 02:11:37
なんかいろいろセミコロンが抜けてるように見えるんだけど
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.
としたのですがどちらも出力をどうすればいいか分かりません。出力の他にも変なところがあれば指摘してくれると嬉しいです。