Вопросы и ответы нах / Zadachi_Gosy_1
.doc-
Задан некоторый набор товаров. Определить для каждого из товаров, какие из них имеются в каждом магазине и каких товаров нет ни в одном магазине.
uses crt;
type tovar=(vd,km,mg,nb,pl,ft);
mnz=set of tovar;
const n=6;
sp:array[0..n-1] of string=('видеокамера','компьютер','магнитофон',
'ноутбук','плеер','фотоаппарат');
var m:array[1..n] of mnz;
res:mnz;
j:tovar;
i,k,p:byte;
nz:string;
begin
clrscr;
writeln('Перечислите какие товары есть в магазине:');
for i:=1 to n do
begin
writeln('Магазин ',i);
m[i]:=[];
writeln('0-видеокамера 1-компьютер 2-магнитофон 3-ноутбук 4-плеер');
writeln('5-фотоаппарат 6-выход');
repeat
readln(k);
if k in [0..5] then m[i]:=m[i]+[tovar(k)];
until k=6;
end;
writeln('Имеются в каждом магазине');
res:=[];
for j:=vd to ft do
begin
k:=0;
for i:=1 to n do
if j in m[i] then k:=k+1;
if k=n then res:=res+[j];
end;
if res=[] then writeln('Таких товаров нет')
else
for j:=vd to ft do
if j in res then write(sp[ord(j)],' ');
writeln;
writeln('Есть хотя бы в одном магазине:');
res:=[];
for j:=vd to ft do
begin
for i:=1 to n do
if j in m[i] then res:=res+[j];
end;
for j:=vd to ft do
if j in res then write(sp[ord(j)],' ');
writeln;
writeln('Нет ни в одном магазине:');
res:=[];
for j:=vd to ft do
begin
k:=0;
for i:=1 to n do
if not(j in m[i]) then k:=k+1;
if k=n then res:=res+[j];
end;
if res=[] then writeln('Таких товаров нет')
else
for j:=vd to ft do
if j in res then write(sp[ord(j)],' ');
readln
end.
2. Дан целочисленный массив с количеством элементов n. Напечатать те его элементы, индексы которых являются степенями двойки (1,2,4,8,…). Задачу решить с использованием процедуры или функции
var
a: array [1..20] of integer;
i: byte;
function step2(i: byte): word;
var
a: word;
j: byte;
begin
a := 1;
for j := 1 to i do
a := a * 2;
step2 := a
end;
begin
randomize;
writeln('целочисленный массив:');
for i := 1 to 20 do
begin
a[i] := random(100);
write(a[i],' ')
end;
writeln;
writeln(' элементы, индексы которых являются степенями двойки: ');
for i := 1 to 4 do
write(a[step2(i)],' ');
readln
end.
3.
Составить двойственную задачу к задаче
f(x)=x1-2x2+3x3-x4→max;
,
x1>=0,…,x3>=0,x4<0.
Решение
Составить двойственную задачу к задаче.
|
|
x1 |
x2 |
x3 |
x4 |
Св.чл. |
|
y1 |
1 |
-1 |
4 |
-3 |
2 |
|
y2 |
1 |
2 |
-1 |
1 |
3 |
|
F |
1 |
-2 |
3 |
-1 |
max |
|
|
y1 |
y2 |
Св.чл. |
|
x1 |
1 |
1 |
1 |
|
x2 |
-1 |
2 |
-2 |
|
x3 |
4 |
-1 |
3 |
|
x4 |
-3 |
1 |
-1 |
|
G |
2 |
3 |
min |
Двойственная задача:
4. В заданном одномерном массиве поменять местами соседние элементы, стоящие на четных местах, с элементами, стоящими на нечетных местах.
Var A:array[1..100] of integer;
i,n,t:integer;
Begin
write('Введите размерность: ');readln(n);
writeln('Исходный массив: ');
For i:=1 to n do
Begin
A[i]:=random(30)-15;
write(A[i]:4);
End;
writeln;
writeln('Преобразованный: ');
i:=0;
While i<n-1 do
Begin
inc(i,1);
t:=A[i];
A[i]:=A[i+1];
A[i+1]:=t;
inc(i,1);
End;
For i:=1 to n do
write(A[i]:4);
readln;
End.
5. Задано некоторое множество М и множество Т того же типа. Подсчитать количество элементов в Т и М, которые не совпадают.
uses crt;
var m,t:set of 'A'..'Z';
i,k:byte;
c:'A'..'Z';
begin
clrscr;
randomize;
m:=[];
t:=[];
for i:=1 to 20 do
begin
c:=chr(random(26)+65);
m:=m+[c];
c:=chr(random(26)+65);
t:=t+[c];
end;
writeln('Множество M:');
for c:='A' to 'Z' do
if c in m then write(c,' ');
writeln;
writeln;
writeln('Множество T:');
for c:='A' to 'Z' do
if c in t then write(c,' ');
writeln;
writeln;
writeln('Совпадающие элементы:');
k:=0;
for c:='A' to 'Z' do
if (c in m)and (c in t)then
begin
k:=k+1;
write(c,' ');
end;
writeln;
if k=0 then write('Совпадающих элементов нет!')
else write('Всего совпадает = ',k);
readln
end.
6. Дана последовательность действительных чисел а1,а2,…,аn. Заменить все её члены, большие данного Z, этим числом. Подсчитать количество замен.
var
a:array[1..100] of integer;
i,n,z:Integer;
c:integer;
begin
Randomize;
Writeln('n=');
Readln(n);
Writeln('z=');
Readln(z);
For i:=1 to n do begin
a[i]:=Random(z+12);
write(a[i]:4);
end;
writeln;
c:=0;
For i:=1 to n do
if a[i] >z then begin
c:=c+1;a[i]:=z;end;
if c<>0 then begin
Writeln('HoBbIu MaccuB :');
For i:=1 to n do
write(a[i]:4);
Writeln;
Writeln('3AMEH :',c);
end
else Writeln('3AMEH HeT');
Readln;
end.
7. Определить те имена учеников, которые встречаются во всех классах данной параллели.
uses crt;
type imena=(lb,tn,ln,ks,ns,mr,jn);//перечислимый тип для создания множеств
mnz=set of imena; //тип множеств
const k=6;
sp:array[0..k] of string=('Люба','Таня','Лена','Ксюша',
'Настя','Марина','Женя');//массив имен
var m:array[1..4] of mnz; //массив множеств-классов
m1,m2:mnz; //вспом. множества
i:imena; //счетчик перечислимого типа
n,j,v:byte; //счетчики целого типа
begin
clrscr;
n:=4;//количество классов в параллели
//формируем множества
writeln('Перечислите в каком из ',n,' классов какие имена)');
for j:=1 to n do
begin
writeln('Класс ',j);
m[j]:=[];
writeln('Выберите имена');
writeln('0-Люба 1-Таня 2-Лена 3-Ксюша 4-Настя 5-Марина 6-Женя 7-выход');
repeat
readln(v);
if v in [0..k] then m[j]:=m[j]+[imena(v)];
until v=7;
clrscr;
end;
//выведнм на экран что получилось
writeln('Полный список имен:');
for i:=lb to jn do
write(sp[ord(i)],' ');
writeln;
writeln('Список имен по классам:');
for j:=1 to n do
begin
write(j:2,' - ');
for i:=lb to jn do
if i in m[j] then write(sp[ord(i)],' ');
writeln;
end;
//выполняем задание по пунктам
writeln('Имена, которые есть в каждом классе:');
m1:=m[1];
for j:=1 to n do
m1:=m1*m[j];
if m1=[] then writeln('Таких имен нет')
else
for i:=lb to jn do
if i in m1 then write(sp[ord(i)],' ');
readln
end.
8. Заполнить таблицу размерности n*n:
1 2 3 … n
1 2 3 … n
……….
1 2 3 … n
program lab4;
type mas=array[1..100, 1..100] of integer;
var a:mas;
i,n,j:integer;
begin
writeln('Vvedite n');
readln(n);
for i:=1 to n do
for j:=1 to n do
a[i,j]:=j;
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j],' ');
writeln;
end;
end.
9. Распечатать список учеников, фамилии которых начинаются на букву В, с указанием даты их рождения.
Program spisok;
Uses crt;
Const n=5; {количество учеников}
Type st=record
f:string; {фамилия}
gr:integer; {год рождения}
Pol:string;{пол ученика}
end;
Var t:array[1..30] of st;
i:integer;
begin
clrscr;
for i:=1 to n do begin
writeln('Сведения о ' ,i,' ученикe');
write('Фамилия: '); readln(t[i].f);
write('Год рождения: '); readln(t[i].gr);
write('Пол: '); readln(t[i].pol);
end;
for i:=1 to n do
if t[i].f[1]= 'В' then
begin write('Фамилия: '); writeln(t[i].f);
write('Год рождения: '); writeln(t[i].gr)
end;
end.
10. Из данного списка спортсменов распечатать сведения о тех из них, кто занимается плаванием. Указать того, кто занимается спортом дольше всех.
Program spisok;
Uses crt;
Type st=record
f:string; {фамилия}
gr:integer; {год рождения}
Vid:string;{вид спорта}
Let:byte;{сколько лет занимется спортом}
end;
Var t:array[1..30] of st;
i,N,max,maxi:integer;
begin
clrscr;
write('введите количество спортсменов: ');readln(N);
for i:=1 to n do begin
writeln('Сведения о ' ,i,' спортсмене');
write('Фамилия: '); readln(t[i].f);
write('Год рождения: '); readln(t[i].gr);
write('Вид спорта: '); readln(t[i].vid);
write('Сколько лет занимается спортом: '); readln(t[i].Let);
end;
max:=t[1].let;
writeln('спортсмены, занимающиеся плаванием:');
for i:=1 to n do begin
if t[i].vid= 'плавание' then begin
write('Фамилия: '); writeln(t[i].f);
write('Год рождения: '); writeln(t[i].gr);
write('Вид спорта: ');writeln(t[i].vid);
write('Сколько лет занимается спортом: '); writeln(t[i].Let);
end;
if max<t[i].let then begin
max:=t[i].let;maxi:=i;end;
end;
writeln('спортсмен,дольше всех занимающийся спортом');
writeln(t[maxi].f);
end.
11. Определить, сколько процентов от всего количества элементов последовательности целых чисел составляют нечетные элементы
var
a: array [1..100] of integer;
i,k,n: byte;
begin
randomize;
write('ВВедите N: '); readln(N);
writeln('Целочисленный массив:');
for i := 1 to N do
begin
a[i] := random(100);
write(a[i],' ')
end;
writeln;
k:=0;
for i:=1 to N do
if a[i] mod 2<>0 then k:=k+1;
write('Нечетные элементы составляют', round(k*100/N),' %');
end.
-
Даны целые положительные числа а1,а2,…,аn. Найти среди них те, которые являются квадратами числа m.
var
a: array [1..100] of integer;
i,n,m: byte;
begin
randomize;
write('ВВедите N: '); readln(N);
writeln('Последовательность положительных чисел:');
for i := 1 to N do
begin
a[i] := random(100);
write(a[i],' ')
end;
writeln;
write('ВВедите m: '); readln(m);
write('Квадратами числа М являются:');
for i:=1 to N do
if a[i]=m*m then write(a[i]);
end.
13.
Найти решение исходной задачи, не решая ее, по решению двойственной задачи. Исходная задача записана в виде:
f= -6*x1- x2 + x3+ 2*x4→min,
3x1- x2 - x3+ x4=1,
x1+ 3x2+ 5x3=9,
x1>=0, x2>=0, x3>=0, x4>=0.
Решение
|
|
x1 |
x2 |
x3 |
x4 |
Св.чл. |
|
y1 |
3 |
-1 |
-1 |
1 |
1 |
|
y2 |
1 |
3 |
5 |
0 |
9 |
|
f |
-6 |
-1 |
1 |
2 |
Min |
Двойственная задача.
|
|
y1 |
y2 |
Св.чл. |
|
x1 |
3 |
1 |
-6 |
|
x2 |
-1 |
3 |
-1 |
|
x3 |
-1 |
5 |
1 |
|
x4 |
1 |
0 |
2 |
|
G |
1 |
9 |
max |
Построим эти прямые на графике и найдем область, которую они ограничивают.
Найдем решение прямой задачи при помощи теоремы о дополняющей нежесткости:
y1*(3x1 - x2 - x3 + x4 - 1) = 0,
y2*(x1 + 3x2 + 5x3 - 9) = 0,
x1*(3*y1 + y2 + 6)=0,
x2*(-y1 + 3*y2 + 1)=0,
x3*(-y1 + 5*y2 - 1)=0,
x4*(y1 - 2)=0.
Отсюда получаем:
3x1 - x2 - x3 + x4 – 1 = 0
x1 + 3x2 + 5x3 – 9 = 0
x3 = 0
x4 = 0
3x1 - x2 = 1
x1 + 3x2 = 9
x1 = 1.2
x2 = 2.6 => X* = (1.2; 2,6; 0; 0).
Проверка на Maple.
14. Дан файл, содержащий различные даты. Каждая дата – это число, месяц и год. Найти самую позднюю дату.
type data=record
den:integer;
mes:integer;
god:integer;
end;
var i,n,code,mingod:integer;
m_d,m_m,m_g:integer;
f:text;
s,x:string;
A:array [1..50] of data;
begin
assign(f,'D:\file.txt'); reset(f);
i:=0;
while not eof(f) do
begin
readln(f,s);
x:=copy(s,1,pos('.',s)-1 );
delete(s,1,pos('.',s) );
val(x,n,code);
inc(i);
A[i].den:=n;
x:=copy(s,1,pos('.',s)-1 );
delete(s,1,pos('.',s) );
val(x,n,code);
A[i].mes:=n;
val(s,n,code);
A[i].god:=n;
end;
n:=i;
m_g:=A[1].god;
for i:=1 to n do
if m_g<A[i].god then m_g:=A[i].god;
m_m:=A[1].mes;
for i:=1 to n do
if (A[i].god=m_g) and (A[i].mes<m_m) then m_m:=A[i].mes;
m_d:=A[1].den;
for i:=1 to n do
if (A[i].god=m_g) and (A[i].mes=m_m)and (m_d<A[i].den) then m_d:=A[i].den;
writeln('MAX data:');
writeln(m_d,'.',m_m,'.',m_g);
close(f);
readln;
end.
15. У прилавка магазина выстроилась очередь из n покупателей. Время обслуживания i-го покупателя равно ti (i=1,…,n).Определить время Сi пребывания i-го покупателя в очереди
type mas=array[1..100] of integer;
var a:mas;
i,j,n:integer;
begin
randomize;
writeln('Vvedite 4islo 4elovek');
readln(n);
for i:=1 to n do
begin
a[i]:=random(10);
writeln('Vremya obslujivaniya ',i,' pokupatelya = ',a[i],' min');
end;
j:=1;
writeln('=====');
for i:=1 to n do
begin
writeln('Vremya v ocheredi ',i,' pokupatelya = ',j,' min');
j:=j+a[i];
end;
end.
16. Заполнить таблицу размерности n*n:
1 2 3 … n-1 n
0 1 2 … n-2 n-1
0 0 1 … n-3 n-2
.……………..
0 0 0 0 … 0 1
program gg;
var
a:array [1..10,1..10]of integer;
i,j,n,k:integer;
begin
writeln('Enter n:');
readln(n);
writeln('Array:');writeln;
for j:=1 to n do
for i:=1 to n do
a[i,j]:=0;
for i:=1 to n do begin k:=1;
for j:=i to n do
begin
a[i,j]:=k;
k:=k+1;
end;end;
for i:=1 to n do begin
for j:=1 to n do begin
write(a[i,j]:3,' ');end;
writeln;
end;
readln;
end.
17. Дана строка. Указать те слова, которые содержат хотя бы одну букву к. Задачу решить с использованием процедуры или функции.
type mas=array[1..100] of string;
var
s,sr:string;
i,k,j:integer;
m:mas;
procedure sl(s:string; var m:mas);
begin
sr:=''; k:=1;
for i:=1 to length(s) do
if (s[i]<>' ') and (s[i]<>'.') and (s[i]<>'!') then sr:=sr+s[i]
else
begin
m[k]:=sr;
k:=k+1;
sr:='';
end;
m[k]:=sr;
end;
begin
writeln('Enter the string:');
readln(s);
sl(s,m);
for i:=1 to k do
begin
sr:=m[i];
for j:=1 to length(sr) do
if (sr[j]='k') or (sr[j]='K') then
begin writeln(m[i]);break; end;
end;
end.
18. Дано натуральное число п. Вычислить:
2/1 + 3/2 + 4/3 + … + (n+1)/n.
program lab18;
var i, n:integer;
sum:real;
begin
writeln('Vvedite n');
readln(n);
sum:=0;
for i:=1 to n do
sum:=sum+(i+1)/i;
writeln('Summa = ', sum);
end.
19. Заполнить таблицу размерности n*n:
n n n .. n
n-1 n-1 n-1 … n-1
……………..….
1 1 1 … 1
program lab19;
type mas=array[1..100, 1..100] of integer;
var a:mas;
i,n,j:integer;
begin
writeln('Vvedite n');
readln(n);
for i:=1 to n do
for j:=1 to n do
a[i,j]:=n-i+1;
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j],' ');
writeln;
end;
end.
20. Дано простое число Р. Найти и вывести на экран следующее за ним простое число. Задачу решить с использованием процедуры или функции.
Решение
program lab1;
var n,i,k:integer;
Label Metka;
function Prost(n:longint):boolean;
var i:longint;
begin
if(n>2)and(n mod 2=0) then
begin
Prost:=false;
exit;
end;
Prost:=true;
for i:=2 to round(sqrt(n)) do
if n mod i=0 then
begin
Prost:=false;
break;
end;
end;
begin
Metka:
write('Vvedite prostoe chislo n = ');
readln(n);
if not(Prost(n)) then
begin
writeln('Eto ne prostoe chislo');
Goto Metka;
end;
i:=n+1;
k:=n+1;
while not Prost(i) do
i:=i+1;
k:=i;
write('Sledyushee prostoe chislo = ', k);
end.
21. Составить программу, которая запрашивает пароль (например, четырёхзначное число) до тех пор, пока он не будет правильно введён.
22. Составить программу для вычисления суммы факториалов, всех чисел, кратных 3, от А до В. Задачу решить с использованием процедуры или функции.
var
i,k,a,b,j,n,p:integer;
fact,sum:longint;
function M(p:integer):longint;
begin
M:=0; fact:=1; k:=1;
if (p mod 3)=0 then
begin
repeat
fact:=fact*k;
k:=k+1;
until k>p;
writeln('Factorial ',p,'=',fact);
M:=fact;
end;
end;
begin
writeln('Enter a and b:');
readln(a,b);
sum:=0;
for i:=a to b do
sum:=sum+M(i);
writeln('Summa factorialov=',sum);
end.
23. Среди работников данного предприятия найти тех трех, чья заработная плата за месяц самая высокая по предприятию, а также распечатать список тех, кто проработал на предприятии менее 3 лет, с указанием их фамилии, зарплаты, стажа работы и должности.
type k=record
name:string;
zp:longint;
staj:integer;
doljnost:string;
end;
var f:file of k;
i,s:integer;
bo:boolean;
fio:string;
a:k;
begin
assign(f,'rabot');
rewrite(f);
writeln('vvedite 4islo rabotnikov');
readln(s);
for i:=1 to s do
begin
writeln('Familiya');
readln(a.name);
writeln('Zarplata');
readln(a.zp);
writeln('Staj');
readln(a.staj);
writeln('Doljnost');
readln(a.doljnost);
write(f,a);
end;
close(f);
reset(f);
s:=0; fio:='';
writeln(' Familiya | zarplata');
writeln('____________________________');
while not (eof(f)) do
begin
read(f,a);
if a.zp>s then begin s:=a.zp; fio:=a.name; end;
end;
writeln(fio:10,' ',s:10);
close(f);
reset(f);
writeln('Staj < 3');
bo:=true;
while not(eof(f)) do
begin
read(f,a);
if (a.staj<3) then
begin
if bo then begin writeln(' Familiya | zarplata | staj | doljnost |');
writeln('______________________________________________'); end;
writeln(a.name:10,' ', a.zp:10,' ', a.staj:4,' ', a.doljnost:10);
bo:=false;
end;
if bo then writeln('Takih ne naydeno');
end;
close(f);
end.
24. Заданы размеры А, В прямоугольного отверстия и размеры x, y, z кирпича. Определить, пройдёт ли кирпич через отверстие.
var a,b,x,y,z:real;
begin
write('a:');
read(a);
write('b:');
read(b);
write('x:');
read(x);
write('y:');
read(y);
write('z:');
read(z);
if (x<a) and (y<b) or (x<b) and (y<a) then
writeln('True')
else
if (x<a) and (z<b) or (x<b) and (z<a) then
writeln('True')
else
if (y<a) and (z<b) or (y<b) and (z<a) then
writeln('True')
else
writeln('False');
end.
25. Решите задачу линейного программирования графическим методом.
f=2x1+x2→min,
x1, x2 0,
2x1+3x2 6,
2x1+x2 4,
x1 1,
x1-x2 -1,
2x1+x2 1.
Решение:
1) 2*x1 + 3*x2 = 6
|
x1 |
x2 |
|
0 |
2 |
|
3 |
0 |
2) 2*x1 + x2 = 4
|
x1 |
x2 |
|
0 |
4 |
|
2 |
0 |
3) x1 = 1
4) x1 – x2 = -1
|
x1 |
x2 |
|
0 |
1 |
|
-1 |
0 |
5) 2*x1 + x2 = 1
|
x1 |
x2 |
|
0 |
1 |
|
0.5 |
0 |
Построим графики всех функций и найдем область, которую они ограничивают.
grad: (0,0) : (2,1).
Точка находится на пересечении 1 и 3 уравнений.
Решим систему:
2*x1 + x2 = 1
x2 = 0
x1 = 0.5
x2 = 0
f(max) = 2*0.5 + 0 = 1.
Проверим на Maple.
> with(plots);
> inequal({2*x1+3*x2<=6, 2*x1+x2<=4, x1<=1, x1-x2>=-1, 2*x1+x2>=1, x1>=0, x2>=0}, x1=-5..5, x2=-5..5, optionsfeasible=(color=blue),optionsexcluded=(color=white));
> with(simplex);
> minimize(2*x1+x2, {2*x1+3*x2<=6, 2*x1+x2<=4, x1<=1, x1-x2>=-1, 2*x1+x2>=1}, NONNEGATIVE);
26. Заполнить таблицу размерности n*n:
2 2 2 … 2
0 4 4 … 4
0 0 8 … 8
………….
0 0 0 … 2n
program lab26;
type mas=array[1..10, 1..10] of integer;
var n,i,j:integer;
a:mas;
begin
writeln('Vvedite razmernost matrici: ');
readln(n);
for i:=1 to n do
for j:=1 to n do
begin
if j<i then a[i,j]:=0
else a[i,j]:=round(exp(i*ln(2)));
end;
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j],' ');
writeln;
end;
readln;
end.
27. Записать в файл последовательного доступа N действительных чисел. Найти разность наибольшего из этих чисел со средним арифметическим всех положительных чисел файла.
program lab27;
var
f:text;
i:integer;
q,max:real;
a:array[1..10] of real;
begin
q:=0;
assign(f,'1.txt');
rewrite(f);
for i:=1 to 10 do
begin
write('vvedite ', i,' chislo ');
readln(a[i]);
write(f,a[i],' ');
writeln;
end;
close(f);
max:=a[1];
for i:=1 to 10 do
begin
if a[i]>max then max:=a[i];
q:=q+a[i];
end;
q:=q/10;
writeln('max = ',max:3:2,' sr.arif = ',q:3:2);
writeln('Raznost max i sr.arif = ',(max-q):3:2);
end.
28. Вычислить количество точек с целочисленными координатами, находящихся в круге радиуса R (R >0).
var i,j,n,r:integer;
begin
writeln('Okrujnost is nachala koordinat!');
writeln('vvedite radius R: ');
readln(r);
n:=0;
for i:=-r to r do
for j:=-r to r do
begin
if sqr(i)+sqr(j)<sqr(r) then
begin
n:=n+1;
writeln(n,') ',i,' ',j);
end;
end;
writeln('v kruge ',n,' tochek');
end.
29. Решите задачу линейного программирования симплексным методом. При решении задачи покажите умения отыскания исходного базиса с помощью введения искусственного базиса:
f=-5*x1+x2-x3→min,
3*x1+x2+x3 + x4 +x5=5,
2*x1 -x2 +3*x4 =4,
x1 +5*x2+6*x3+x4 =11.
|
|
