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
