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 ('--------------------');
Writeln (' | X | Y ');
writeln ('--------------------');
P1(a,b,XH,N);
for U:=1 to N do writeln('',masx[u]:10:7,' ',masy[u]:10:7);readln;
end.
Раздел: Файлы
1.Описание: Решает простейшие арифметические примеры записанные в файл.
program pn12;
var f:text; s,sa,sb:string; c:char; i,a,b,o,j,code:integer; m,op:set of char;
begin m:=['1','2','3','4','5','6','7','8','9','0'];
op:=['+','-','*','/'];
assign(f,'file.txt');reset(f);
while not(eof(f)) do begin readln(f,s);
writeln(s);
for i:=2 to length(s)-1 do if (s[i] in op)and (s[i-1]in m) and (s[i+1]in m) then begin j:=1;
sa:='';
while (s[i-j] in m) and (i-j>0) do begin sa:=s[i-j]+sa;
j:=j+1 end;
j:=1;
sb:='';
while (s[i+j] in m) and (i+j<=length(s)) do begin sb:=sb+s[i+j];
j:=j+1 end;
val(sa,a,code);val(sb,b,code);
case s[i] of '+':O:=a+b;
'-':O:=a-b;
'*':O:=a*b;
'/':O:=a div b; end;
writeln(a,s[i],b,'=',O,' ')
end;end; close(f);
readln;
end.
2.Описание: Работа с текстовыми файлами предусматривает собой: создание, редактирование, добавление, удаление.
Program one;
uses Dos,Crt;
var f :text;
FileName :string[9];
st :string; ch :char; vibor :byte;
procedure Head;
begin Writeln('esli vy otkazyvaetes ot deistviya,to naberite v nazvanii faila simvola""');
Write('vvedite imya faila:>');
Readln(FileName);
if FileName='~' then halt(1) else Assign(f,FileName); end;
procedure TextEdit;
begin Writeln('Seichas vy smojetedobavlyat informaciyu v file.');
Writeln('esli vyzahotite prekratit vvod, to naberite sleduschuyu posledovatelnost:"~~"');
repeat Write('>');Readln(st);
if st<>'~~' then Writeln(f,st);
until st='~~'; end;
procedure WriteToFile;
begin Head;
ReWrite(f);
TextEdit;
Close(f);
Writeln('Vy okonchili vvodit info v file.Najmite lubuyu knopku...');
ReadKey; end;
procedure ReadFromFile;
Head;
Reset(f);
if IOresult<>0 then begin Writeln('file ',FExpand(filename),' ne sushestvuet.');
Writeln((Y/N).');
ch:=ReadKey;
if (ch='Y') or (ch='y') then ReadFromFile;
end else begin Writeln('Soderjimoe faila:');Writeln;
while not eof(f) do begin Readln(f,st);
Writeln('>',st); end;
Close(f);
Writeln;
Writeln('Najmite lubuyu knopku');
ReadKey; end;end;
procedure AddToFile;
begin Head;
Append(f);
if IOresult<>0 then begin
Writeln('faila ',FExpand(filename),' ne sushestvuet.');
Writeln('hotite vvesti drugoe imya faila?(Y/N).');
ch:=ReadKey;
if (ch='Y') or (ch='y') then AddToFile; end else begin TextEdit; Close(f);
Writeln('Vy okon4ili vvodit info v file.Najmite lubuyu knopku...');
ReadKey; end; end;
procedure DelFile;
begin Head;
Reset(f);
if IOresult<>0 then begin Writeln('file ',FExpand(filename),' ne sushestvuet.');
Writeln('hotite vvesti drugoe imya file??(Y/N).');
ch:=ReadKey; if (ch='Y') or (ch='y') then DelFile; end else begin Writeln('vy uvereny 4to hotite udalit etot file?(Y/N)');
ch:=ReadKey; if (ch='Y') or (ch='y') then Erase(f);
Writeln('vy tolko 4to udalili file.Najmite lubuyu klavishu..');
Readkey; end; end;
procedure Menu;
begin repeat repeat ClrScr;
Writeln('1. record file / sozdanie faila');
Writeln('2. read file');
Writeln('3. Dobavlenie info v file');
Writeln('4. delet file');
Writeln('5. Exit');
Write('Vash vybor:>');Readln(vibor);
until (vibor>0) and (vibor<6);
Writeln;
Write('‚л ўлЎа «Ё : ');
case vibor of 1:begin Writeln(' record file / sozdanie faila');
WriteToFile; end;
2:begin Writeln('read file');
ReadFromFile; end;
3:begin Writeln(' Dobavlenie info v file');
AddToFile; end;
4:begin Writeln('delet file');
DelFile; end; end;
until vibor=5; end;
begin Menu;
end.
3.Описание: Дан файл, содержащий текст и арифметические выражения вида, а*в, где * - один из знаков +, -, *, /.Выписать все арифметические выражения и вычислить их значения
program pn12;
var f:text; s,sa,sb:string; c:char; i,a,b,o,j,code:integer; m,op:set of char;
begin m:=['1','2','3','4','5','6','7','8','9','0'];
op:=['+','-','*','/'];
assign(f,'e:\tp\tp6\Arif.dat');reset(f);
while not(eof(f)) do begin readln(f,s);
writeln(s);
for i:=2 to length(s)-1 do if (s[i] in op)and (s[i-1]in m) and (s[i+1]in m) then begin j:=1;
sa:='';
while (s[i-j] in m) and (i-j>0) do begin sa:=s[i-j]+sa;
j:=j+1 end;
j:=1; sb:='';
while (s[i+j] in m) and (i+j<=length(s)) do begin sb:=sb+s[i+j];
j:=j+1 end;
val(sa,a,code);val(sb,b,code);
case s[i] of '+':O:=a+b;
'-':O:=a-b; '*':O:=a*b; '/':O:=a div b; end;
writeln(a,s[i],b,'=',O,' ')
end; end;
close(f);
end.
4.Описание: Вывести максимальное число из файла in.txt
Program one;
var t:text; i,p,code:integer; s:string; m:array[1..100] of real; max:real;
begin assign(t,'in.txt'); reset(t);
read(t,s);
i:=0;
repeat p:=pos(' ',s);
inc(i);
val(copy(s,1,p-1),m[i],code);
delete(s,1,p);
until p=0;
max:=m[1];
for p:=2 to i do if m[p]>max then max:=m[p];
writeln('MAX= ',max);
close(t);
readln;
end.
5.Описание: Перекодирование файла из формата DOS в формат Windows.
Program one;
var f,g:text; i,p,n:integer; m:array [1..100] of string; s:string;
begin assign(f,'in.txt'); reset(f);
assign(g,'out.txt'); rewrite(g);
while not eof(f) do begin readln(f,s); {считываем очередную строку}
i:=0; {ставим счётчик слов на 0}
repeat inc(i); {увеличиваем счётчик текущего ПРЕДЛОЖЕНИЯ}
p:=pos(' ',s); {смотрим где находится пробел}
m[i]:=copy(s,1,p-1); {записываем текущее слово в массив}
delete(s,1,p); {то слово, которое заприсали в массив - удаляем}
until p=0; {****************}
n:=i+1; {конец массива}
if s[length(s)]='.' then begin m[n]:=copy(s,1,length(s)-1); m[1]:=m[1]+'.' {то эту точку перемещаем на 1 слово}
end else m[n]:=s; {а если нет точки - то просто его записываем в массив}
writeln(g);;
for i:=n downto 1 do write(g,m[i],' '); {идём с конца массива в начало и записываем слова в обратном порядке}end;
writeln('PEREZAPISANO...');readln;
close(f); close(g);
end.
6.Описание: Удаление следующих друг за другом нескольких пробелов из файла.
Program one;
const
FileName: String = 'Strings.txt';
VAR f: Text; S: String;
BEGIN Assign(f, FileName); {$I-}Reset(f); {$I+}
if IOResult = 0 then begin ReadLn(f, S); Close(f) end;
WriteLn('input string: ',S);
while (POS(' ', S) > 0) do delete(S, POS(' ',S), 1);
if ( length(S) > 1) and (S[1] = ' ') then Delete(S, 1, 1);
if (length(S)>1) and (S[length(S)] = ' ') then Delete(S, length(S), 1);
writeln('output string: ',s);
readln;
END.
7.Описание: Вывести содержимое файла в обратном порядке в новый файл.
program one;
uses crt;
var fl1,fl2:text;a,b:string; i,l:longint;
begin clrscr;
assign(fl1,'input.txt');
assign(fl2,'output.txt'); reset(fl1); readln(fl1,a);
close(fl1);
l:=length(a);
for i:=l downto 1 do b:=b+a[i];
rewrite(fl2); write(fl2,b);
close(fl2);
write(b); readln;
end.
8.Описание: Бинарный поиск элемента в типизрованном longint файле.
program searches;
uses crt,dos;
type longint_file=file of longint;
procedure files_names_query(var read_file,error:string; var search_value:longint);
var f:text;
begin error:='';
write('‘считываемый файл: ');
readln(read_file);
assign(f,read_file);
reset(f);
if (ioresult=0) then begin close(f);
write('находимое значение=');
readln(search_value);
end else begin error:='ошибка:файл не существует'; end; end;
function bin_search(left,right,search_value:longint;var f:longint_file):boolean;
var center,value,new_left,new_right,right_value,center_value:longint;
begin if (left=right) then begin seek(f,left);
read(f,value);
if (value=search_value) then begin bin_search:=TRUE;
end else begin bin_search:=FALSE; end;
end else begin center:=((left+right) div 2)+1;
seek(f,right);
read(f,right_value);
seek(f,center);
read(f,center_value);
if ((search_value>=center_value)and(search_value<=right_value)) then begin new_left:=center;
bin_search:=bin_search(new_left,right,search_value,f);
end else begin new_right:=center-1;
bin_search:=bin_search(left,new_right,search_value,f); end; end; end;
function search(read_file:string; search_value:longint):boolean;
var f:longint_file;
finded:boolean;
elements_count:longint;
begin assign(f,read_file);
reset(f);
finded:=FALSE;
elements_count:=filesize(f);
finded:=bin_search(0,elements_count-1,search_value,f);
close(f);
search:=finded; end;
procedure writing_to_file(write_file:string;finded:boolean;begin_time:longint);
var f:text; hour,minutes,seconds,seconds100:word; end_time:longint; time:real;
begin gettime(hour,minutes,seconds,seconds100);
end_time:=minutes*60*100+seconds*100+seconds100;
time:=(end_time-begin_time)/100;
assign(f,write_file);
rewrite(f);
if (finded) then writeln(f,'ok') else writeln(f,'error');
writeln(f,time:4:2);
close(f); end;
procedure writing(finded:boolean; begin_time:longint);
begin if (finded) then begin writeln('Element finded complete');
end else begin writeln('Element not finded'); end;
readln; end;
var read_file,write_file,error,search_value_string:string; hour,minutes,seconds,seconds100:word;
begin_time,search_value:longint; k:integer; result:boolean;
begin gettime(hour,minutes,seconds,seconds100);
begin_time:=minutes*60*100+seconds*100+seconds100;
if (paramstr(1)<>'') then begin read_file:=paramstr(1);
search_value_string:=paramstr(2);
val(search_value_string,search_value,k);
write_file:=paramstr(3);
result:=search(read_file,search_value);
writing_to_file(write_file,result,begin_time);
end else begin files_names_query(read_file,error,search_value if (error='')
then begin result:=search(read_file,search_value);
writing(result,begin_time);
end else begin writeln(error);
writeln('нажмите Enter для продолжения.');
readln; end; end;
end.
9.Описание: Вывести таблично результаты расчета функции y=sin(x)/x на указанном диапазоне в файл.
Program one;
Const M=24;
Var FName: Text; AB,H,X: Real;
Function F(X:Real):Real;
Begin F:=Abs(Sin(X)/X);
End;
Begin Write ('vvedite na4alo diapazona: ');
ReadLn (A);
Write ('vvedite konec diapazona: ');
ReadLn (B);
WriteLn('sozdayu LA-BA.TAB');
H:=(B-A)/M;
X:=A;
Assign(FName,'LA-BA.TAB');
ReWrite(FName);
WriteLn (FName,'X | F(X)');
While (X<=B) Do Begin WriteLn (FName,X,' | ',F(X));
X:=X+H;
End;
Close (FName);
End.
10.Описание: Дан файл, содержащий текст. Сколько слов в тексте? Сколько цифр в тексте?
program one;
Const mn=['0'..'9'];
Var f3:text; i,j,ch,sl:integer; name:string; s:char; wrd :string;
Begin writeln('vvedite imya faila');
readln(name);
assign(f3,name);
reset(f3);
s:=' '; sl:=0; ch:=0;
while not eof(f3) do begin readln(f3,wrd);
i:=1;
While i<=length(wrd) do begin if wrd[i]<>' ' then sl:=sl+1;
while (wrd[i]<>' ') and (i<=length(wrd)) do inc(i);
inc(i) end; end;
close(f3);
reset(f3);
while not eof(f3) do begin while not eoln(f3) do begin read(f3,s);
if (s in mn) then ch:=ch+1;
end; readln(f3); end;
writeln('4islo slov: ',sl,' 4islo cifr: ',ch);
close(f3);
End.
11.Описание: Заменить синонимами слова в файле
program ;