p align="left">uses crt; const n=5; var a:array[1..n] of integer; i:integer; begin clrscr; randomize; for i:=1 to n do begin a[i]:=random(9); write(a[i]); end; writeln; for i:=1 to n do begin if odd(a[i])=false then a[i]:=1 else a[i]:=0; write(a[i]); end; readkey; end. Раздел: Процедуры и функции 1.Описание: Найти последовательности целых чисел те, которые встречаются в ней ровно два раза. program one; uses crt; type mas=array[1..100]of integer; func=function(var x:mas):integer; var a:mas; j,n,m,x:integer; function kolichestvo(var c:mas):integer; var k,i:integer; begin k:=0; for i:=1 to n do if c[i]>m then k:=k+1; kolichestvo:=k; end; procedure deist(var b:mas; operation:func); begin writeln('b[j]'); for j:=1 to n do readln(b[j]); for j:=1 to n do write(b[j],' '); writeln; x:=operation(a); end; begin clrscr; writeln('vvedite celoe chislo m i razmer massiva(n)'); readln(m,n); deist(a,kolichestvo); writeln('kolichestvo=',x); readkey; end. 2.Описание: Процедура отображения рамки в текстовом режиме program frame; uses Crt; procedure Frm(l:integer; t:integer; w:integer; h:integer); var x,y:integer; i:integer; c1,c2,c3,c4,c5,c6:char; begin clrscr; c1:=chr(218); c2:=chr(196); c3:=chr(191); c4:=chr(179); c5:=chr(192); c6:=chr(217); GoToXY(l,t); write(c1); for i:=1 to w-2 do write(c2); write(c3); y:=t+1; x:=l+w-1; for i:=1 to h-2 do begin GoToXY(l,y); write(c4); GoToXY(x,y); write(c4); y:=y+1; end; GoToXY(l,y); write(c5); for i:=1 to w-2 do write(c2); write(c6); end; begin Frm(2,2,15,10); readln; end. 3.Описание: Произведение нечетных элементов Program one; type massiv= array [1..100] of integer; var A1,A2:massiv; i,j:integer; n1,n2:integer; function pr_nec(m:massiv; n:integer):integer; var i,j,pr:integer; begin pr:=1; for i:=1 to n do if odd(m[i]) then pr:=pr*m[i]; pr_nec:=pr; end; begin writeln('Vvedite PERVYI massiv:'); write('ego razmer "n": '); readln(n1); for i:=1 to n1 do begin write('A1[',i,']='); readln(A1[i]); end; writeln('_______________________'); writeln('Vvedite VTOROI massiv:'); write('ego razmer "n": '); readln(n2); for i:=1 to n2 do begin write('A2[',i,']='); readln(A2[i]); end; writeln('_______________________'); writeln; writeln('Vi vveli:'); write('A1: '); for i:=1 to n1 do write(A1[i],' '); writeln; write('A2: '); for i:=1 to n2 do write(A2[i],' '); writeln; writeln; writeln('Proizvedenie iz A1= ',pr_nec(A1,n1)); writeln('Proizvedenie iz A2= ',pr_nec(A2,n2)); readln; end. 4.Описание: Нахождение тангенса tg и котангенса ctg угла, используя выражения sin(x)cos(x) и обратное ему. Program one; uses crt; var y1,y2,z: real; function tg (x : real) : real; begin tg := sin(x)/cos(x); end; function ctg (x : real) : real; begin ctg := cos(x)/sin(x); end; Begin clrscr; write ('input x: '); readln (z); y1:=tg(z); y2:=ctg(z); writeln ('tg (',z:0:2,')=',y1:0:2); writeln ('ctg (',z:0:2,')=',y2:0:2);readln; End. 5. Описание: Определить максимальное число из четырех введенных, путем сравнения их сначала попарно, а затем результат между собой. program one; uses crt; var a,b,c,d,z,x,y,x1,y1:integer; function max(x,y:integer):integer; begin if x>y then max:=x else max:=y; end; begin clrscr; writeln('Vvedite chisla'); readln(a,b,c,d); x1:=max(a,b); y1:=max(c,d); z:=max(x1,y1); writeln('max=',z); readkey; end. 6.Описание: Вычислить день недели по дате program Kalendar; uses crt; var y,d,m,c,w: integer; {m-mesiac,d-den, y-god }Procedure WriteDay(d,m,y:Integer); constDays_of_week: rray [0..6] of String [11] =('Voskresen`e','Ponedelnik','Vtornik', ' Sreda', ' Chetverg', ' Piatnica', ' Subbota') ; Begin if m <3 then begin m := m + 10; y := y - 1;end else m := m - 2;c := y div 100;y := y mod 100;w := (d+(13*m-1) div 5+y+y div 4+c div 4-2*c+777) mod 7; WriteLn(Days_of_week[w] );end; Procedure InputDate(var d,m,y : Integer); Begin Write('Vvedite datu v formate DD MM GG '); ReadLn(d,m,y); if (d>=1)and (d<=31) and (m>=1) and (m<=12) and (y>=1582) and (y<=4903) then Writeday(d,m,y) else begin writeln ('Nekorrektnyj vvod!');end;end; BEGIN clrscr; InputDate(d,m,y); readkey; End. 7. Описание: Нахождение процента от числа Program one; uses crt; var k,n:byte; x:real; function procent(n,m:byte):real; begin procent:=m*100/n; end; begin clrscr; writeln('Vvedite chisla'); readln(k,n); x:=procent(k,n); writeln('x=',x:5:2); readkey; end. 8. Вывести заданное число звездочек. program one;; uses crt; var n:byte; function zvezda(n:byte):real; var i:integer; s:string; begin i:=1; s:=''; while i<=n do begin s:=s+'*'; inc(i); end; writeln(s); end; begin clrscr; writeln('Vvedite chislo'); readln(n); zvezda(n); readkey; end. 9. Описание: Функция возведения числа в степень. С учетом дробных чисел и частных случаев, когда числа отрицательные или равны нулю program one; Uses crt; var x,y,z:real; Function Pow(A,B:Real):Real; Var T,R:Real; L:integer; Begin T := Abs(A); If A < 0 Then R := (-1)*Exp(B*Ln(T)) else if A > 0 Then R := Exp(B*Ln(T)) else R:=0; L := round(B); If (L mod 2 = 0) Then R:=Abs(R); If (B=0) Then R:=1; Pow:=R; End; BEGIN clrscr; Writeln('vvedite chislo:'); readln(x); Writeln('vvedite stepen:'); readln(y); z:=Pow(x,y); Writeln(z:0:2); readkey; END. 10. Описание: Вывести заданный символ заданное количество раз program one; uses crt; var n:byte; l:string; function zvezda(n:byte;l:string):real; var i:integer; s:string; begin i:=1; s:=''; while i<=n do begin s:=s+l; inc(i); end; writeln(s); end; begin clrscr; writeln('Vvedite chislo'); readln(n); writeln('Vvedite simvol'); readln(l); zvezda(n,l); readkey; end. 11.Описание: Определить к чему ближе меньшее из двух чисел: к их среднему арифметическому или среднему геометрическому. Program one; vara,b : real; average : real; geometricmean : real; minstr : string;function min(a,b : real) :real; begin min := a; minstr := 'Pervoe'; if (b < a) then begin min := b; minstr := 'Vtoroe';end;end; beginwrite('Vvedite 1-e chslo: ');readln(a); write('Vvedite 2-e chslo: ');readln(b); average := (a + b) / 2; geometricmean := sqrt(a*a + b*b); a := min(a,b); writeln('Naimenshee chislo - ',minstr,' (',a:0:3,')'); write('Blize k srednemu '); if (abs(average - a) < abs(geometricmean - a)) thenbegin writeln('arifmeticheskomu (',average:0:3,')'); end else begin writeln('geometricheskomu (',geometricmean:0:3,')');end; readln; end. 12.Описание:Возведение в степень для целого показателя, вычисляемого за время log2(степень). Program power_maximal; Uses crt; Var a,b,c: integer; function power (x,pow:integer):integer; var res: integer; begin res := 1; while (pow > 0) do beginif (pow and 1 = 1) then res:= res * x; x := x * x; pow := pow shr 1;end; power := res; end; Begin Clrscr; Writeln ('input a,b: '); Readln (a,b); c:=power(a,b); Writeln('a^b = ',c); Readkey; End.ъ 13.Описание:Арккосинус числа. Нахождение из математических соображений var ca,al,albeg: real; function ArcCos(arg:real):real; var r:real; begin if (abs(arg)>1) then begin writeln(' Unavailable argument '); halt; end; if abs(arg)<0.000001 then r := pi/2 else r := ArcTan(sqrt(1/arg/arg-1)); { arccos } if arg<0 then r:=pi-r; ArcCos := r; end; begin albeg:=pi/2+0.2; ca := cos(albeg); al := arccos(ca); writeln('ArcCos(',ca:10:7,')=',al:10:7,' AlBeg=',albeg:10:7, ' ChekSum =',al-albeg,' Must be sero'); readln; end. 14.Описание:Есть ли в строке числовые значения Function NumInStr(S: String): Boolean; VAR C, I: INTEGER; N: BOOLEAN; BEGIN; I:=0; Repeat; I:=I+1; C:=Ord(S[I]); N:=( (C >= 48) AND (C <= 57) ); Until (NOT N) OR (I=Length(S)); NumInStr:=N; END; 15.Описание:Нахождение функции методом половинного деления program half_del; uses crt; type ms=array[1..100] of real; { [x,y] } var Eps,XH,DX,Y,z,X,YH,P,S,A,B:real; N,U,Er:integer; masx,masy:ms;Function F(X:real):real; beginF:=exp(x)+x*x-2 end; Function FuncA(Eps,s,p,YH:real):real; begin if F(p)*F(s)<0 then begin YH:=0.5*(p+s); while abs(F(YH)) > EPS do begin If F(p)*F(YH) <0 then S:=YH else P:=YH; YH:=0.5*(P+S) end; end else er:=1; FuncA:=YH; end; procedure P1(a,b,XH:real; N:integer); var z,q:real; u:integer; begin if x>1 then begin Z:=sqrt(X*sqrt(X-1)); a:=FuncA(Eps,s,p,YH); for U:=1 to N do begin masx[U]:=X; masy[U]:=sin(x)/z; X:=X+DX; end; {else writeln(' Error: x<1 ');} end; end; Begin clrscr; write ('vvedite eps: '); readln(eps); Write ('vvedite dx: '); readln(DX); write ('vvedite N: '); readln(N); write ('vvedite x>1 :'); readln(x); if x1; writeln; Writeln ('--------------------');
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
|