program test3; var a, b, c, max, min: integer; begin read(a); max := a; min := a; read(b); if b > max then max := b; if b < min then min := b; read(c); if c > max then max := c; if c < min then min := c; writeln('max', max); writeln('min', min); end.
662 名前：デフォルトの名無しさん mailto:sage [03/10/16 01:29]
program maxandmin; (* IF無しバージョン *)
var a, b, c, max, min : integer;
function sgn(si : integer) : integer; begin if si < 0 then sgn := -1 else if si = 0 then sgn := 0 else if si > 0 then sgn := 1; end;
begin read(a); read(b); read(c); case sgn(a - b) of -1, 0 : case sgn(b - c) of -1, 0 : begin min := a; max := c; end; 1 : case sgn(a - c) of - 1, 0 : begin min := a; max := b; end; 1 : begin min := c; max := b; end; end; end; 1 : case sgn(b - c) of -1, 0 : case sgn(a - c) of -1, 0 : begin min := b; max := c; end; 1 : begin min := b; max := a; end; end; 1 : begin min := c; max := a; end; end; end; writeln('max=', max); writeln('min=', min); end.
663 名前：662 mailto:sage [03/10/16 01:30]
あ、sgn に if文を使っているんだっけ。
664 名前：でたらめ mailto:sage [03/10/16 21:41]
function sgn (si: integer): integer; begin case si of 0: si := 0; otherwise begin sgn := si div abs(si); end; end; end;
665 名前：でたらめ mailto:sage [03/10/16 21:42]
あ。begin, end 一個余分だ。
function sgn (si: integer): integer; begin case si of 0: si := 0; otherwise sgn := si div abs(si); end; end;
666 名前：でたらめ mailto:sage [03/10/17 10:56]
program MaxMinX; (* ObjectPascal ver. *) type MMXtype = object vmax, vmin: integer; procedure init; procedure setValue (val: integer); function max: integer; function min: integer; end; procedure MMXtype.init; begin vmax := -32768;vmin := 32767; end; procedure MMXtype.setValue (val: integer); begin if val > vmax then vmax := val; if val < vmin then vmin := val; end; function MMXtype.max: integer; begin max := vmax; end; function MMXtype.min: integer; begin min := vmin; end; var MMX: MMXtype;a, i: integer; begin new(MMX); MMX.init; for i := 1 to 3 do begin read(a); MMX.setValue(a); end; writeln('max=', MMX.max); writeln('min=', MMX.min); end.
667 名前：662 mailto:sage [03/10/17 18:42]
program test(input, output); (* 今度こそIF無しバージョン *) Type TChoice = function(a, b : integer) : integer; var Func : array[boolean] of TChoice; a, b, c : integer;
function First(a, b : integer) : integer; begin First := a; end;
function Second(a, b : integer) : integer; begin Second := b; end;
function fmax(a, b : integer) : integer; begin fmax := Func[a >= b](a,b); end;
function fmin(a, b : integer) : integer; begin fmin := Func[a <= b](a,b); end;
program MMX; var a, b, c: integer; begin read(a); read(b); read(c); writeln('max=', ((((a + b) + abs(a - b)) div 2 + c) + abs(((a + b) + abs(a - b)) div 2 - c)) div 2); writeln('min=', ((((a + b) - abs(a - b)) div 2 + c) - abs(((a + b) - abs(a - b)) div 2 - c)) div 2); end.
var i,n,max,min :integer; sin:array[1..100] of integer; begin write('人数は？'); readln(n); for i:=1 to n do begin writeln(i,'人目の身長を入力してください'); readln(sin[i]); end; max:=sin[1]; min:=sin[1]; for i:=2 to n do begin IF sin[i]>max then max:=sin[i]; IF sin[i]<min then min:=sin[i]; end; writeln('人数 制御変数 身長 最高 最低 '); writeln(n); for i:=1 to n do begin write(' ',i,' ', sin[i] ); IF sin[i]:=max then write(' ',sin[i]); IF sin[i]:=min then write(' ',sin[i]); end; end.
こんな強引な感じになりましたが一応例どおり動きました。 Program en9a(input,output); var i,n :integer; max,min :real; sin:array[1..100] of integer; begin write('人数は？'); readln(n); for i:=1 to n do begin writeln(i,'人目の身長を入力してください'); readln(sin[i]); end; max:=sin[1]; min:=sin[1]; writeln('人数 制御変数 身長 最高 最低 '); writeln(n);
709 名前：６７６ [03/11/04 12:18]
i:=1; repeat IF sin[i]>max then max:=sin[i]; IF sin[i]<min then min:=sin[i]; write(' ',i,' ', sin[i]); IF sin[i]=max then write(' ',max:3:1); IF sin[i]=min then write(' ',min:3:1); writeln; i:=i+1; until i<>1; for i:=2 to n do begin IF sin[i]>max then max:=sin[i]; IF sin[i]<min then min:=sin[i]; write(' ',i,' ', sin[i]); IF sin[i]=max then write(' ',max:3:1); IF sin[i]=min then write(' ',min:3:1); writeln; end; end.
710 名前：６７６ Ｂのほう [03/11/04 12:19]
Program en9b(input,output); var i,n :integer; max,min :real; sin:array[1..100] of integer; begin n:=1; i:=1; writeln(i,'人目の身長を入力してください'); readln(sin[i]); while sin[i]<>0 do begin i:=i+1; writeln(i,'人目の身長を入力してください'); readln(sin[i]); n:=n+1; end; max:=sin[1]; min:=sin[1]; writeln('人数 制御変数 身長 最高 最低 '); writeln(n-1);
711 名前：６７６ Ｂのほう２ [03/11/04 12:20]
i:=1; repeat IF sin[i]>max then max:=sin[i]; IF sin[i]<min then min:=sin[i]; write(' ',i,' ', sin[i]); IF sin[i]=max then write(' ',max:3:1); IF sin[i]=min then write(' ',min:3:1); writeln; i:=i+1; until i<>1; for i:=2 to n-1 do begin IF sin[i]>max then max:=sin[i]; IF sin[i]<min then min:=sin[i]; write(' ',i,' ', sin[i]); IF sin[i]=max then write(' ',max:3:1); IF sin[i]=min then write(' ',min:3:1); writeln; end; end.
program sifuto(input,uotput); type suuji = array[1..10] of char; var a : suuji; x,y,n : integer; begin begin write('１０文字入力'); readln(a); end; write('いくつずらす？'); readln(x); for y:= 11-x to 10 do write(a[y]); for n:=1 to 10-x do write(a[n]); writeln() end.
720 名前：デフォルトの名無しさん mailto:sage [03/11/05 20:11]
今日配列使って作ったもう一個のﾔﾂ program sinnsuu(input,output); type suuji = array[1..4] of integer; var a : suuji; c, ans : integer; d : integer; begin Write('Decimal : '); Read(d); c := 0; while d <> 0 do begin c := c + 1; ans := d mod 2; d := d div 2; a[c]:=ans end; for c:= 4 downto 1 do write(a[c]); writeln() end.
とりあえず、簡単なサンプル(Delphi6で確認）。 何かキーを押すと終了する。 program Project2; {$APPTYPE CONSOLE} uses Windows, SysUtils, Win32Crt; var f, b: Integer; begin for b := 0 to 15 do begin ClrScr; for f := 0 to 15 do begin TextColor(f); TextBackground(b); gotoXY(f * 2, f); Writeln('Test String [', WhereX, ',', WhereY, ']'); Sleep(1000); if KeyPressed then Exit end end end.
function ReverseString( S : String ) : string; var I, J : Integer; begin J:=Length(S); SetLength( Result, J); for I:=1 to J do Result[i]:=S[J+1-I]; end;
実行してないんで動くかどうかはシラネ
769 名前：デフォルトの名無しさん mailto:sage [03/11/22 15:47]
program rev; var st : string; i : integer;
procedure swap(var a, b : char); var t : char; begin t := a; a := b; b := t; end;
begin readln(st); for i := 1 to length(st) div 2 do swap(st[i], st[length(st) - i + 1]); writeln(st); end.
function ReverseString(S : string) : string; var i : integer; begin for i := 1 to length(S) do result := concat(S[i], result); end;
777 名前：デフォルトの名無しさん mailto:sage [03/11/24 17:04]
再帰バージョン
function reverseString (a: string): string; begin if length(a) <= 1 then reverseString := a else reverseString := concat(reverseString(omit(a, 1, 1)), a[1]); end;
program Hoge; {$APPTYPE CONSOLE} var bignum : array [1..30] of Integer; function keta: Integer; var i : Integer; begin i := 30; while (bignum[i] = 0) and (i > 1) do i := i - 1; keta := i; end; { keta } procedure nibai; var i : Integer; begin for i := 1 to 30 do bignum[i] := bignum[i] * 2; for i := 1 to 29 do begin bignum[i+1] := bignum[i+1] + bignum[i] div 10; bignum[i] := bignum[i] mod 10; end;end; { nibai } procedure print; var i : Integer; begin for i := 30 downto 1 do Write(bignum[i]);end; { print } procedure init; var i : Integer; begin for i := 2 to 30 do bignum[i] := 0; bignum[1] := 1;end; { init } begin init; while keta < 30 do nibai; print; end.
784 名前：デフォルトの名無しさん mailto:sage [03/11/25 09:49]
procedure init; var i : Integer; begin Read(i); bignum[1] := i; for i := 1 to 29 do begin bignum[i+1] := bignum[i] div 10; bignum[i] := bignum[i] mod 10; end; end; { init }
program ensyu(input,output); const msg ='英単語の綴りを逆順にします。'; var engword,downword:string[30]; Len,i :integer; begin writeln(msg); write('英単語は？'); readln(engword); Len:=length(engword); for i:=Len downto 1 do begin downword:=downword+engword[i]; end; writeln('逆順にした綴りは',downword,'です。'); readln; end.
786 名前：デフォルトの名無しさん mailto:sage [03/11/25 12:41]
function ReverseString(S: String): String; var i, j : integer; c : char; begin i := 1; j := Length(S); while i < j do begin c := S[i]; S[i] := S[j]; S[j] := c; i := i + 1; j := j - 1; end; ReverseString := S; end; { ReverseString }
787 名前：デフォルトの名無しさん mailto:sage [03/11/25 13:54]
激遅 function ketaketa(e : extended):integer; begin while true do begin e:=e*2; if log10(e)>=30 then break; end; ShowMessage（FloatToStr(e)); end;
788 名前：デフォルトの名無しさん mailto:sage [03/11/25 14:16]
procedure ketaketa(e : extended); begin while log10(e) < 30-1 do e:=e*2; ShowMessage（FloatToStr(e)); end;
789 名前：デフォルトの名無しさん mailto:sage [03/11/25 14:39]
procedure ketaketa(e : extended); var i : Integer; begin for i := 1 to Ceil((30-1 - log10(e)) / log10(2)) do e := e * 2; ShowMessage（FloatToStr(e)); end;
program enshu(input,output); const K=30; var i,j,m,v, :integer n :array[1..K]of integer; begin write('出発の値は？'); readln(m); if m >0 then begin ............. while m<>0 do begin ............. end; J:=J+1; ・・。
795 名前：782 mailto:age [03/11/26 03:28]
while j > 1 do begin for i:=K downto J do n[i]:= 2*n[i]; for i:=K downto J do begin ............... end; if n[i-1]<>0 then j:=j-1 end; for i:=1 1 to K do write(chr(n[i]+Ord('0'))); writeln end; readln end.
スマソ全然わかんないです・
796 名前：デフォルトの名無しさん mailto:sage [03/11/26 09:14]
program enshu(input,output); const K= 30; var i,j,m : integer; {var i,j,m,v, : integer} n : array[1..K]of integer; begin write('出発の値は？'); readln(m); if m >0 then begin j := K; while m<>0 do begin n[j] := m mod 10; m := m div 10; j := j - 1; end; J:=J+1;
797 名前：デフォルトの名無しさん mailto:sage [03/11/26 09:15]
while j > 1 do begin for i:=K downto J do n[i]:= 2*n[i]; for i:=K downto J do begin n[i-1] := n[i-1] + n[i] div 10; n[i] := n[i] mod 10; end; if n[j-1]<>0 then j:=j-1 { if n[i-1]<>0 then j:=j-1 } end; for i:= 1 to K do { for i:=1 1 to K do } write(chr(n[i]+Ord('0'))); writeln end; readln end.
続きです Personarray=array[index] of person; procedure sort(n:index;var x:personarray); procedure exchangeperson(var A,B:person);
var temp:person; begin ・・・ end;
var i,j:index; begin for i:=1 to N-1 do for j:=N-1 downto 1 do ・・・ end;
var num:o..nmax; i:index; Student:personarray; Infile:text; Filename:string[80]; begin ・・・ end.
801 名前：デフォルトの名無しさん mailto:sage [03/11/27 20:25]
あのー、少しは自分でやった方がいいと思うよ？ せめて、自分が考えたものを書くとかしたほうが。
802 名前：デフォルトの名無しさん mailto:sage [03/11/27 22:18]
コンパイル通しただけだから、バグ取りは自分で program seiretu(input,output); const nmax = 100; type index = 1..nmax; Person = record name : string[14]; math,eng : 0..100; total : 0..200; end; Personarray = array[index] of person; procedure sort(n : index; var x:personarray); procedure exchangeperson(var A,B : person); var temp : person; begin temp := A; A := B; B := temp; end; var i,j: index; begin for i:=1 to N-1 do for j:=N-1 downto i do if x[j+1].total < x[j].total then exchangeperson(x[j+1], x[j]); end;
803 名前：デフォルトの名無しさん mailto:sage [03/11/27 22:19]
var num : 0..nmax; i : index; Student : personarray; Infile : text; Filename : string[80]; begin Write('データファイル名は？'); Readln(Filename); i := 1; Assign(Infile, Filename); while not eof(Infile) do begin Readln(Infile, Student[i].name, Student[i].math, Student[i].eng); i := i + 1; end; num := i - 1; sort(num, Student); for i := 1 to num do Writeln(Student[i].name, Student[i].math, Student[i].eng, Student[i].total); end.
function hoge(n, base: integer): string; var x: integer; s: string; begin if (base <> 2) and (base <> 8) and (base <> 16) then base := 16; s := ''; repeat x := n mod base; if x < 10 then s := chr(ord('0') + x) + s else s := chr(ord('A') + x - 10) + s; n := n div base; until n <= 0; hoge := s; end;
hogeは関数名、nは変換する数値、baseは変換の基底、stringは文字列 baseが2,8,16以外だったらbaseを16にしてる。 n mod baseで一の位が分かる。 数値から文字への変換。'0'の次が'1'、'A'の次が'B' n div baseは整数の割り算。base進数で一の位を削る 0になったら終了。関数の返り値をsにする。
６乗までだから大丈夫でしょう。 function hoge(x, n: integer): integer; const k = 1000000; var i, j: integer; begin x := x mod k; j := 1; for i := 1 to n mod 6 do j := j * 10; hoge := (x mod j) * (k div j) + x div j end;
procedure move; var i, right, left, temp: integer; begin right := foo[1] div 50; for i := 2 to N do begin left := foo[i] * i div 100; foo[i-1] := foo[i-1] - right + left; temp := right; right := foo[i] * i div 50; foo[i] := foo[i] + temp - left; end; end;
{ 事前に元量配列に量をセットしておく} for 遷移回数ループ do begin 計算配列を0クリア for 最初の要素から最後の要素まで do begin 左右の漏れ率計算 左右の漏れ量、残り量計算 計算配列に漏れ量と残り量を加える end; 元量配列に計算配列を代入 {途中結果の出力(遷移回数,元量配列)} end; {最終結果出力（元量配列)}
皆様のアドバイスを単に組み合わせただけですが以下のように記述してみました。 type foo=array [1..100] of real; var data:foo; i,j,n:integer; right,left,temp:real; begin write('移動する個数は？'); readln(n); data[1]:=100; j:=0; repeat right:=data[1]/50; for i:=2 to n do begin left:=data[i]*i/100; data[i-1]:=data[i-1]-right+left; temp:=right; right:=data[i]*i/50; data[i]:=data[i]+temp-left end; j:=j+1 until j=100; for i:=1 to n do begin writeln(i,'番目の定常値は',data[i]:5:3,'です。') end.
type x=array [1..5] of real; var data:x; a,n:integer; begin for n:=1 to 5 do data[n]:=random; for n:=1 to 5 do writeln(data[n]) end. こんなプログラムでいつも同じ乱数しか返ってこないのですが 違う乱数を得るにはどうしたらいいんでしょうか？
type foo=array [1..100] of real; var data:foo; i,j,n,k,m:integer; right,left,temp:real; begin write('行列の全人数は？'); readln(n); write('何ステップ？'); readln(k); write('窓口の数は？'); readln(m); {初期値の設定} data[1]:=1; j:=0; repeat {最初に人がが到着する確率} right:=data[1]*・・・; {移動} for i:=2 to n do begin {窓口でのサービス提供} if i<=m then begin {サービス終了率} left:=data[i]*・・・; data[i-1]:=data[i-1]-right+left; temp:=right; right:=data[i]*・・・; data[i]:=data[i]+temp-left end
891 名前：883 mailto:sage [04/01/12 15:48]
{待ち行列} else begin {途中放棄率？} left:=data[i]*・・・; data[i-1]:=data[i-1]-right+left; temp:=right; right:=data[i]*・・・; data[i]:=data[i]+temp-left end; end j:=j+1 {決められたステップ数まで} until j=k; for i:=1 to n do writeln(i,'番目の定常値は',data[i]:5:10,'です。') end. 待ち行列に用いて行列の定常値を求めるには こんな感じにすればいいんでしょうか？
(A^N/N!)/(Σ(A^X)/) Xは１からNまで type hako=array [1..100] of real; hako2=array [1..100] of real; hako3=array [1..100] of real; var box:hako; box2:hako2; box3:hako3; n,b,x,y,z,temp:integer; ue,a,seki,total,kotae,goukei:real; begin write('Nは？'); readln(n); write('Aは？'); readln(a); seki:=1; for b:=1 to n do begin seki:=seki*a; box[b]:=seki end; x:=0; y:=1; z:=0; repeat x:=x+1; y:=y*x; temp:=y; z:=z+1; box2[z]:=temp until z=n; ue:=seki/y;
896 名前：デフォルトの名無しさん mailto:sage [04/01/13 09:50]
for b:=1 to n do box3[b]:=box[b]/box2[b]; total:=0; for b:=1 to n do total:=total+box3[b]; goukei:=total+1; kotae:=ue/goukei; writeln('求める値は',kotae:5:3,'です。') end. こんな感じであってますか？
type box1=array [1..100] of longint; box2=array [1..100] of longint; var hako:box1; hako2:box2; i,n:integer; p,q,r:real; begin p:=0; q:=1; r:=0; repeat p:=p+1; q:=q*p; r:=r+1; hako[r]:=q until r=10; for i:=Low(hako) to High(hako) do hako2[i]:=hako[High(hako)-i]; for n:=1 to 10 do writeln(hako2[n]) end. 上のプログラムのようにリピートを用いた記述で 配列の入れ替えを行うと0しか戻ってこない場合はどうしたらいいですか？
function 実際の再帰で開平を求める関数(範囲の最低値, 範囲の最高値: real); var 二分点: real; begin 二分点 := (範囲の最低地 + 範囲の最高値)/2; if (二分点 * 二分点) < c then result := 実際の再帰で開平を求める関数(二分点, 範囲の最高値) else (二分点 * 二分点) > c result := 実際の再帰で開平を求める関数(範囲の最低値, 二分点) else result := 二分点; end;
begin 実際の再帰開平を求める関数（0, c）// 初期値は 0 から c までとする。 end;
958 名前：デフォルトの名無しさん [04/07/26 01:12]
レポートが出たのですが、全く分かりません↓ LD A－Aをレジスターに格納する ST A－レジスターの中身をAに格納 AD A－レジスターの中身とAを足して、レジスターに格納 SB A－レジスターの中身とAを足して、レジスターに格納 ML A－レジスターの中身とAを掛けて、レジスターに格納 DV A－レジスターの中身をAで割って、レジスターに格納 接尾辞表現で ABC*+DE-/（普通に書いたら(A+B*C)/(D-E))と入力して 上の指示表現を使って答えを解いていくための別のプログラムを書くとしたら LD B ML C ST TEMP1 LD A AD TEMP1 ST TEMP2 LD D SB E ST TEMP3 LD TEMP2 DV TEMP3 ST TEMP4 と表示できるようなプログラムをpascalで作りなさい。という内容です。 ヒント 式を順にスタックに入れていって、 最初のBC*はop2:=c;op1:=b;として、取り出していくそうです 人助けだと思ってお願いします(ToT)/~~~
４: (B * C -> X) => (LD B / ML C / ST TEMP1) ６: (A + X -> Y) => (LD A / AD TEMP1 / ST TEMP2) α: (D - E -> Z) => (LD D / SB E / ST TEMP3) γ: (Y / Z -> W) => (LD TEMP2 / DV TEMP3 / ST TEMP4)
>>974 ありがとうございます。問題文を見直した所、with p と書かれています。問題の間違いですかね? with文についてググったのですが 「Pascalでレコードのメンバーを扱うには「レコード名.メンバー名」という書式を使うが、 レコード名をある程度省略する方法がある。それにwithを使う。 withの内部では「メンバー名」を書くだけで、そのレコードのメンバーが参照できる。」とありました。 例えば穴埋問題の部分には(p^)のelementメンバにxを代入したいわけですが、 ここは「(p^).」を付けずに element := x; と書ける、ということですか? 書けるとしたら、p^.elementと書くのは間違いとなるのでしょうか?
976 名前：上とは別人 mailto:sage [04/08/22 16:42]
>>969 のtype tree = @node;は、type tree = ^node; じゃないのかなあ…まあ、Pascalも方言多いから何とも言えんけど with p or with p^も、Delphiなんかじゃrecordへのポインタに直接"."を続けられるから間違いとも言い切れ無さげ… あと、withは、名前を探す順番を変えるだけなので、p^.elementももちろん書ける…私の知ってるPascalであれば…
