Ответы к билетам по информатике-1
.doc1.
uses Crt;
const
N=10; type
Tmass=array[1..N] of -1..1; procedure FillMass(var m:TMass); var
i:Word;
begin
Randomize;
for i:=1 to N do m[i]:=random(3)-1;
end;
procedure Sort(var m:TMass;var NOperations:Word);
var
m_tmp:TMass;
j:ShortInt;
i:Word;
p:Word;
begin
for i:=1 to N do m_tmp[i]:=1;
p:=1;
NOperations:=N; for j:=-1 to 0 do
for i:=1 to N do if m[i]=j then
begin
m_tmp[p]:=j;
inc(NOperations);
inc(p);
end;
m:=m_tmp;
end;
procedure PrintMass(m:TMass);
var
i:Word;
begin
for i:=1 to N do Write(m[i],' ');
end;
var
mass:Tmass;
NOp:Word; begin MainProgram ClrScr; FillMass(mass); WriteLn('Исходный массив: '); PrintMass(mass); Sort(mass,NOp); WriteLn(#13#10'Отсортированный массив: '); PrintMass(mass);
WriteLn;
WriteLn('Элементов в массиве: ',N);
WriteLn('Сортировка выполнена за ',NOp,' шагов');
ReadKey; end.
2.
uses Crt; const
konstanta='eoi3r34ohfl $KIBAB$ ksnlhq4076ap3ojgd;krl49'; var
stroka_simvolov:string;
function Main(inp_konstanta, inp_stroka:string):boolean;
var
i:Byte;
L:Byte;
is_first_present, is_last_present:boolean;
begin
is_first_present:=FALSE;
is_last_present:=FALSE;
L:=Length(inp_stroka); for i:=1 to L do
begin
if inp_konstanta[1]=inp_stroka[i] then is_first_present:=TRUE; if inp_konstanta[L]=inp_stroka[i] then is_last_present:=TRUE;
end;
Main:=is_first_present and is_last_present; end;
begin
ClrScr;
Write('Введите строку символов: ');ReadLn(stroka_simvolov); WriteLn(Main(konstanta,stroka_simvolov)); ReadKey;
end.
3.
uses Crt;
function Pow(x,y:Real):Real;
begin
Pow:=exp(y*ln(abs(x))); end;
var
x,y:Real;
begin
MainProgram
ClrScr; Write('X:');ReadLn(x); Write('Y:');ReadLn(y); WriteLn('Result=',Pow(x,y):5:3); ReadLn;
end.
4.
uses Crt;
procedure OpenFile(filename:string); var
f:Text;
str:string;
begin
Assign(f,filename);
Reset(f);
WriteLn('Содержимое файла ',filename,':'); WriteLn('**********');
while not eof(f) do
begin
ReadLn(f,str);
WriteLn(str); end;
Close(f);
WriteLn('**********'); end;
var
inp:string;
begin
MainProgram
ClrScr;
Write('Введите имя файла для открытия: ');ReadLn(inp); OpenFile(inp);
ReadKey; end.
5.
uses Crt;
function Invert(inp_string:string):string;
var
Result:string; i,L:Byte;
begin L:=Length(inp_string); Result:='';
for i:=1 to L do Result:=Result+inp_string[L-i+1]; Invert:=Result;
end;
var
str:string;
begin
MainProgram
ClrScr;
Write('Введите строку: ');ReadLn(str);
WriteLn('Результат: ',Invert(str));
ReadKey; end.
6.
uses Crt;
function IsArranged(filename:string):boolean;
var
f:file of Char;
Ch,previos:Char; begin Assign(f,filename); Reset(f); previos:=#0; IsArranged:=TRUE; while not eof(f) do
begin
Read(f,Ch);
if ord(Ch)<ord(previos) then IsArranged:=FALSE;
previos:=Ch;
end;
end;
var
str:string;
begin
MainProgram
ClrScr;
Write('Введите имя файла: ');ReadLn(str);
WriteLn(IsArranged(str));
ReadKey;end.
7.
uses Crt;
function Delete_Leading_spaces(inp_str:string):string;
begin
while inp_str[1]=' ' do Delete(inp_str,1,1);
Delete_leading_spaces:=inp_str; end;
var
str:string;
begin
MainProgram
ClrScr;
Write('Введите строку: ');ReadLn(str); WriteLn(Delete_leading_spaces(str)); ReadKey;
end.
8.
uses Crt, DOS;
function GetCount(extension:string):Byte;
var
S:SearchRec;
N:Byte; begin FindFirst('?.'+extension,AnyFile,s); N:=0;
while DosError=0 do
begin
inc(N);
FindNext(S); end;
GetCount:=N; end; var ext:string; begin MainProgram ClrScr;
Write('Введите расширение для поиска: ');ReadLn(ext);
WriteLn('В текущей директории находится ',GetCount(ext),' файлов с расширением ',ext); ReadKey;
end.
9.
uses Crt;
var
x:Integer;
IsLess0:boolean; begin MainProgram ClrScr; Write('Введите X: ');ReadLn(x); IsLess0:=x<0;
case IsLess0 of
TRUE : WriteLn(x*x); FALSE : WriteLn(x);
end;
ReadKey; end.
10.
uses Crt;
procedure InsertCharacter(Filename:string;Ch:Char);
var
f:Text;
f_tmp:Text;
s:string;
begin
Assign(f,Filename);
Assign(f_tmp,'$$$');
Reset(f);
Rewrite(f_tmp); while not eof(f) do
begin
ReadLn(f,s); WriteLn(f_tmp,s);
end;
Close(f); Close(f_tmp); Rewrite(f); Reset(f_tmp); WriteLn(f,Ch); while not eof(f_tmp) do
begin ReadLn(f_tmp,s); WriteLn(f,s);
end;
Close(f);
Close(f_tmp);
Erase(f_tmp); end; var Filename:string; Ch:Char; begin MainProgram ClrScr;
Write('Введите имя файла и символ для добавления: ');ReadLn(FileName);ReadLn(Ch); InsertCharacter(Filename,Ch);
WriteLn('Добавление окончено.');
ReadKey;
11.
uses Crt;
type
TPos=record
X:Char;
Y:Byte; end;
procedure King(pos:TPos);
var
i:Char;
j:Byte;
begin
for i:=pred(pos.X) to succ(pos.X) do
begin
for j:=pred(pos.Y) to succ(pos.Y) do
Write(i,j,' ');
WriteLn; end;
end;
var
inp_pos:TPos;
begin
MainProgram
ClrScr;
WriteLn('Введите позицию, на которой стоит король. Позиции на краю доски не задавать!');
Write('Сначала вводим букву: ');ReadLn(inp_pos.X);
Write('Теперь цифру: ');ReadLn(inp_pos.Y);
King(inp_pos);
ReadKey; end.
12.
uses Crt;
function Main(a,b:Word):Word;
begin
dec(a);
dec(b);
if b>0 then Main:=Main(a,b)
else Main:=a;
end;
var
a,b:Word;
begin
MainProgram
ClrScr;
Write('a= ');ReadLn(a);
Write('b= ');ReadLn(b);
WriteLn('a-b=',Main(a,b));
ReadKey; end.
13.
uses Crt;
function Main(a,b:Word):Word;
begin
inc(a);
dec(b);
if b>0 then Main:=Main(a,b)
else Main:=a;
end;
var
a,b:Word;
begin
MainProgram
ClrScr;
Write('a= ');ReadLn(a);
Write('b= ');ReadLn(b);
WriteLn('a+b=',Main(a,b));
ReadKey; end.
14.
uses Crt;
function main(a,b:Integer):integer;
begin
if(b=0) or (a=0) then main:=0
else main:=a+main(a,b-1);
end;
var
a,b:Integer;
begin
MainProgram
ClrScr;
Write('a= ');ReadLn(a);
Write('b= ');ReadLn(b);
WriteLn('a*b=',Main(a,b));
ReadKey;end.
15.
uses Crt;
function IsInFile(filename,number:string):boolean;
var
f:Text;
inp_str:string;
begin
Assign(f,filename);
Reset(f);
IsInFile:=FALSE; while not eof(f) do
begin ReadLn(f,inp_str); if pos(number,inp_str)<>0 then
begin
IsInFile:=TRUE;
Close(f); exit;
end;
end;
end;
var fname,n:string;
begin
MainProgram
ClrScr;
Write('Введите имя файла: ');ReadLn(fname);
Write('Введите число для поиска: ');ReadLn(n);
WriteLn(IsInFile(fname,n));
ReadKey; end.
16.
uses Crt;
function CapsLettersCount(s:string):Byte;
var
i,i_k:Byte;
cnt:Byte;
begin
i_k:=Length(s);
cnt:=0;
for i:=1 to i_k do
if s[i] in ['A'..'Z','А'..'Я'] then inc(cnt);
CapsLettersCount:=cnt; end;
var
inp_str:string;
begin
MainProgram
ClrScr;
Write('Введите строку символов: ');ReadLn(inp_str);
WriteLn('В введенной Вами строке содержится ',CapsLettersCount(inp_str),' заглавных букв'); ReadKey;
end.
17.
uses Crt;
const
E:Real=0.001; type
xy=record
x,y:Real; end;
function g(z : xy) : real;
var
r_x,r_y:Real;
begin
r_x:=z.x*z.x;
r_y:=z.y*z.y;
g:=SQRT(r_x+r_y);
end;
function IsEqual(a,b:Real):boolean;
begin
if a>b then IsEqual:=a-E<b+E
else IsEqual:=b-E<a+E;
end;
function f(a,b,c : xy) : boolean;
var
r_a,r_b,r_c:Real;
begin
f:=FALSE;
r_a:=g(a);
r_b:=g(b);
r_c:=g(c);
if IsEqual(r_a,r_b) and IsEqual(r_b,r_c) then f:=TRUE;
end;
var
a,b,c:xy;
begin
MainProgram
ClrScr;
Write('Координата X первой точки: ');ReadLn(a.x);
Write('Координата Y первой точки: ');ReadLn(a.y);
Write('Координата X второй точки: ');ReadLn(b.x);
Write('Координата Y второй точки: ');ReadLn(b.y);
Write('Координата X третьей точки: ');ReadLn(c.x);
Write('Координата Y третьей точки: ');ReadLn(c.y);
WriteLn(f(a,b,c));
ReadKey; end.
18.
uses Crt; const
E:Real=0.001; type
drob=record
chis,
znam:Integer; end;
function f(a,b: drob): boolean;
var
eval_a,eval_b:Real;
begin
eval_a:=a.chis/a.znam;
eval_b:=b.chis/b.znam;
if abs(eval_b-eval_a)<E then f:=TRUE
else f:=FALSE;
end;
var
a,b:drob;
begin
MainProgram
ClrScr;
Write('Введите числитель 1-й дроби: ');ReadLn(a.chis);
Write('Введите знаменатель 1-й дроби: ');ReadLn(a.znam);
Write('Введите числитель 2-й дроби: ');ReadLn(b.chis);
Write('Введите знаменатель 2-й дроби: ');ReadLn(b.znam);
WriteLn(f(a,b));
ReadKey;end.
19.
uses Crt; const
N=4; type
TMatrix=array[1..N,1..N] of Integer; const
m_exp:TMatrix=
(
(6,1,2,4),
(1,8,9,7),
(2,9,7,0),
(4,7,0,5)
);
function IsSymmetric(m:TMatrix):boolean;
var
i,j:Byte;
begin
IsSymmetric:=TRUE; for i:=1 to N do
for j:=i+1 to N do
if m[i,j]<>m[j,i] then IsSymmetric:=FALSE;
end;
var
i,j:Byte;
m:TMatrix;
begin
MainProgram
ClrScr;
WriteLn(IsSymmetric(m_exp));HALT;
WriteLn('Вам необходимо ввести матрицу ',N,'x',N); for i:=1 to N do
begin
for j:=1 to N do
begin
Write(' ':2,'(',i,',',j,')=');ReadLn(m[i,j]); end;
WriteLn; end;
WriteLn(IsSymmetric(m));
ReadKey; end.
20.
uses Crt; const
n = 1000; Fn='file20.txt';
type
abc = array [1..n] of (a,b,c); var
t, q : abc;
f:file of abc;
procedure CreateFile(var q:abc);
begin
Rewrite(f);
Write(f,q);
Close(f); end;
procedure ReadFromFile(var t:abc); begin
Reset(f);
Read(f,t);
Close(f); end; begin MainProgram ClrScr; Assign(f,Fn); ReadKey; end.