Ответы: 4рк массив данных
Описание
Характеристики ответов (шпаргалок)
Список файлов
- 4рк массив данных
- infa.txt 4,76 Kb
- Города и температура.txt 1,4 Kb
- Другая задача с точками.txt 1,05 Kb
- Куклы.txt 1,63 Kb
- Спортсмены.txt 1,14 Kb
- Точки.txt 1,47 Kb
- Треугольники.txt 1,37 Kb
- Упорядочить студентов.txt 1,11 Kb
- Упорядочить, найти лучшего студента (с процедурами).txt 1,56 Kb
Служебный роман 1977 СССР 159 мин. Кавказская пленница 1967 СССР 78 мин. Джентльмены удачи 1971 СССР 84 мин.
Легенда №17 2013 Россия 124 мин. Экипаж 2016 Россия 138 мин. Челюсти 1975 США 123 мин. Криминальное чтиво 1994 США 168 мин
type
trec = record
naz: string[100];
god: real;
ctr: string[100];
budg: real;
end;
tmas = array[1..20]of trec;
st = string[100];
procedure vvod(var a: tmas; var n: byte);
var
i: byte;
begin
writeln('Введите количество фильмов ');
readln(n);
for i := 1 to n do
begin
write('введите название фильма ');readln(a[i].naz);
write('введите год выпуска ');readln(a[i].god);
write('введите страну в которой был снят ');readln(a[i].ctr);
write('введите продолжительность в мин ');readln(a[i].budg);
end;
end;
procedure vivod( a: tmas; n: byte);
var
i: byte;
begin
writeln(' ', 'Фильм', ' ', 'Год выпуска', ' ', 'Страна', ' ', 'продолжительность в мин');
for i := 1 to n do
writeln(a[i].naz:20, (a[i].god):10:0, a[i].ctr:12, (a[i].budg):18:0)
end;
procedure maxbudg(a:tmas; n: byte);
var
i, j: byte; max: real; b: tmas;
begin
for i := 1 to n do
b[i] := a[i];
max := b[1].budg;
for j := 1 to n do
if b[j].budg > max then max := b[j].budg;
writeln('Самая большая продолжительность ', max:4:0);
end;
procedure newmas(a:tmas; n: byte);
var
i,k, j: byte; s: st; c: tmas;
begin
k:=0;
writeln('Введите страну');
readln(s);
for i := 1 to n do
if a[i].ctr = s then
begin
k:=k+1;
c[k]:=a[i];
end;
if k=0 then writeln('Нет фильмов снятыв в этой стране')
else
begin
writeln('Получивщийся массив');
writeln(' ', 'Фильм', ' ', 'Год выпуска', ' ', 'Страна', ' ', 'продолжительность в мин');
for j := 1 to k do
writeln(c[j].naz:20, c[j].god:10:0, c[j].ctr:12, c[j].budg:18:0)
end;
end;
procedure newmas2(a:tmas; n: byte);
var
i,g, j,k: byte; s1: st;
l:real;
d: tmas;
begin
g:=0;
writeln('Введите страну');
readln(s1);
writeln('Введите год');
readln(l);
for i := 1 to n do
if (a[i].ctr = s1) and (a[i].god>l) then
begin
g:=g+1;
d[g]:=a[i];
end;
if g=0 then writeln('Нет фильмов подходящих под критерии')
else begin
writeln('Получивщийся массив');
writeln(' ', 'Фильм', ' ', 'Год выпуска', ' ', 'Страна', ' ', 'продолжительность в мин');
for j := 1 to g do
writeln(d[j].naz:20, d[j].god:10:0, d[j].ctr:12, d[j].budg:18:0)
end;
end;
procedure sortnaz(a:tmas; n: byte);
var i,j,k,o:byte; buf:trec; e: tmas;
begin
for k:=1 to n do
e[k] := a[k];
for i:=1 to n-1 do
for j:=i+1 to n do
if e[j].naz[1]<e[i].naz[1] then
begin
buf:=e[i];
e[i]:=e[j];
e[j]:=buf;
end;
writeln('Получивщийся массив');
writeln(' ', 'Фильм', ' ', 'Год выпуска', ' ', 'Страна', ' ', 'продолжительность в мин');
for o := 1 to n do
writeln(e[o].naz:20, e[o].god:10:0, e[o].ctr:12, e[o].budg:18:0)
end;
procedure sortgod( a:tmas;n: byte);
var i,j,k,o:byte; buf:trec; f:tmas;
begin
for k:=1 to n do
f[k] := a[k];
for i:=1 to n-1 do
for j:=i+1 to n do
if f[j].god<f[i].god then
begin
buf:=f[i];
f[i]:=f[j];
f[j]:=buf;
end;
writeln('Получивщийся массив');
writeln(' ', 'Фильм', ' ', 'Год выпуска', ' ', 'Страна', ' ', 'продолжительность в мин');
for o := 1 to n do
writeln(f[o].naz:20, f[o].god:10:0, f[o].ctr:12, f[o].budg:10:0)
end;
procedure udal(var a:tmas; var n:byte);
var i,j,p: byte;
begin
writeln('введите номер элемента который удаляется');
readln(p);
j:=0;
for i:=1 to n do
if i<>p then
begin
j:=j+1 ;
a[j]:=a[i];
end;
n:=j;
end;
var
a, b, e,f,d,c,q: tmas;
n, i, m,k,o,p: byte;
l:real;
s,s1:st;
buf:trec;
begin
while true do
begin
writeln('1-Ввод');
writeln('2-Вывод');
writeln('3-Нахождение максамальной продолжительность в мин ');
writeln('4-Формирование масива фильмов в определюнной стране и после определённого года');
writeln('5-Сортировать по алфавиту названия');
writeln('6-Сортировать по году выпуска');
writeln('7-Формирование масива фильмов снятых в определюнной стране');
writeln('8-удаление элемента');
writeln('9-выход');
writeln('Введите номер пункта ');
readln(m);
case m of
1:vvod(a, n);
2:begin writeln('Массив записей');vivod(a, n); end;
3:maxbudg(a,n);
4:newmas2(a,n);
5:sortnaz( a, n);
6:sortgod( a, n);
7:newmas(a,n);
8:udal(a,n);
9:exit;
end;
end;
readln;
readln;
end.
program temperatura;
{$APPTYPE CONSOLE}
uses
SysUtils;
type goroda=record
nazvanie:string[20];
temp:integer;
end;
tmas=array[1..10] of goroda;
massiv=array[1..20] of string;
procedure VVOD (var A:tmas;var n:integer);
var i:integer;
begin
writeln('VVedite kolichestvo gorodov');
readln(n);
for i:=1 to n do begin
writeln('Vvedite nazvanie');
readln(A[i].nazvanie);
writeln('Vvedite temperaturu');
readln(A[i].temp);
end;
end;
procedure VIBOR (A:tmas;n:integer;var B:massiv;var kol:integer);
var i,nizk:integer;
begin
nizk:=a[1].temp;
for i:=1 to n do if a[i].temp<nizk then nizk:=a[i].temp;
kol:=0;
for i:=1 to n do if a[i].temp=nizk then begin
kol:=kol+1;
B[kol]:=a[i].nazvanie;
end;
end;
procedure SORT (var B:massiv;kol:integer);
var i,j:integer;
buf:string;
begin
for j:=1 to kol-1 do
for i:=1 to kol-j do
if B[i]> B[i+1]then begin
buf:=B[i];
B[i]:=B[i+1];
B[i+1]:=buf;
end;
end;
var Gor:tmas;
Nizk:massiv;
i,n,k:integer;
begin
VVOD(Gor,n);
VIBOR(Gor,n,Nizk,k);
SORT(Nizk,k);
writeln;
Writeln ('Yporiadochennii massiv strok');
for i:=1 to k do write (Nizk[i],' ');
writeln;
readln;
end.
запись точки,сортирует по длине от точки до следующей точки
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type XY=record
x:integer;
x1:integer;
y:integer;
y1:integer;
l:real;
end;
Tmas=array [1..100] of XY;
procedure vvod (var A:tmas;var n:integer);
Var i:integer;
begin
writeln ('vvedite kolvo elementov');
readln (n);
writeln ('VVEDITE massiv');
for i:=1 to n do begin
writeln ('vvedite x');
readln (A[i].x);
writeln ('vvedite x1') ;
readln (A[i].x1);
writeln ('vvedite y');
readln (a[i].y);
writeln ('vvedite Y1') ;
readln (A[i].y1); end;
end;
procedure vivod (a:tmas;n:integer);
var i: integer;
begin
writeln ('l' );
for i:=1 to n do
writeln (A[i].l:2:3);
end;
procedure sort (var A:tmas;var n:integer);
var i,j:integer; b:XY;
begin
for i:=1 to n do
A[i].l:=sqrt(sqr(A[i].x-A[i].x1)+sqr(A[i ].y-A[i].y1));
for i:=1 to n do begin
for j:=1 to n-i do
if a[j].l>a[j+1].l then begin
b:=A[j];
A[j]:=A[j+1];
A[j+1]:= B; end; end;
end;
var b:tmas;k:integer;
BEGIN
vvod (b,k);
sort (b,k);
vivod (b,k);readln;
END.
program igruski;
{$APPTYPE CONSOLE}
uses
SysUtils;
type igruski=record
nazvanie:string[10];
zena:integer;
min:integer;
max:integer;
end;
tmas=array[1..10] of igruski;
procedure VVOD (var A:tmas; var n:integer);
var i:integer;
begin
repeat writeln('Vvedite kolichestvo igrushek (ne bolshe 10)');
readln(n);
until n<=10;
for i:=1 to n do begin
writeln('Vvedite nazvanie');
readln(A[i].nazvanie);
writeln('Vvedite zenu');
readln(A[i].zena);
writeln('Vvedite minimalnii vozrast');
readln(A[i].min);
writeln('Vvedite maximalnii vozrast');
readln(A[i].max);
end;
end;
procedure PROV (A:tmas;n:integer;sum:integer;vozr:integ er;var C:tmas;var kol:integer);
var i:integer;
begin
kol:=0;
for i:=1 to n do if (sum>A[i].zena) and (vozr>a[i].min) and (vozr<a[i].max) then begin
kol:=kol+1;
C[kol]:=A[i];
end;
end;
procedure VIVOD (A:tmas;kol:integer);
var i:integer;
begin
if kol=0 then writeln('Takix igrushek net')
else writeln ('Nazvanie Zena Min vozr Max vozr');
for i:=1 to kol do writeln (A[i].nazvanie,' ',A[i].zena,' ',A[i].min,' ',A[i].max);
end;
var B,D:tmas;
n,k,summa,vozrast:integer;
begin
VVOD(B,n);
writeln ('Vvedite vashu summu deneg');
readln(summa);
writeln('Vvedite vozrast rebenka');
readln(vozrast);
writeln('Isxodnii massiv');
VIVOD(B,n);
writeln;
writeln('To,chto podoidet po vozrastu i zene');
PROV(B,n,summa,vozrast,D,k);
VIVOD(D,k);
readln;
end.
PROV(B,n,D,k);
VIVOD(D,k);
readln;
end.
program cpot;
{$APPTYPE CONSOLE}
uses
SysUtils;
type sport=record
fam:string[10];
ball:array [1..3] of integer;
end;
sportsmen=array[1..10] of sport;
procedure VVOD(var A:sportsmen; var n:integer);
var i,j:integer;
begin
writeln('Vvedite kolichestvo sportsmenov');
readln(n);
for i:=1 to n do begin
writeln('Vvedite familiu');
readln(A[i].fam);
writeln('Vvedite 3 rezultata');
for j:=1 to 3 do begin
read (a[i].ball[j]);
end;
readln;
end;
end;
procedure VIVOD(A:sportsmen;n:integer);
var i,j:integer;
begin
writeln('Familia ball 1 ball 2 ball 3');
for i:=1 to n do begin writeln(a[i].fam,' ');
for j:=1 to 3 do write(a[i].ball[j]:6);
end;
end;
function REC (A:sportsmen;n:integer;star:integer):boo lean;
var i,j,s:integer;
begin
REC:=false;
for i:=1 to n do begin
S:=0;
for j:=1 to 3 do S:=s+a[i].ball[j];
if S>star then
REC:=true;
end;
end;
var Sp:sportsmen;
n,star:integer;
begin
VVOD(Sp,n);
writeln('Vvedite starii rezultat');
readln(star);
if REC(Sp,n,star) then writeln('ruzeltat pobit')
else writeln('rezultat ne pobit');
readln;
end.
Дан массив записей о точках на плоскости. Проверить, расположены ли расстояния от точек до начала координат в порядке возрастания, если нет - отсортировать.
program toch;
{$APPTYPE CONSOLE}
uses
SysUtils;
type tochki=record
x:real;
y:real;
end;
tmas=array[1..20] of tochki; {massiv tochek}
var n,m:integer;
t:tmas;
i:integer;
procedure vvod(n1:integer;var t1:tmas);
var i:integer;
begin
for i:=1 to n1 do begin
writeln('Vvedite koordinaty X',i);readln(t1[i].x);
writeln('Vvedite koordinaty Y',i);readln(t1[i].y);
end;
end;
procedure vivod(n1:integer;t1:tmas);
begin
for i:=1 to n1 do
writeln(t1[i].x:2:0,' ',t1[i].y:2:0);
end;
function rast(x1:real;y1:real):real;
var q:real;
begin
q:=sqrt(sqr(x1)+sqr(y1));
rast:=q;
end;
procedure proverka(n1:integer;var m1:integer; var t1:tmas);
var p,j:integer;
ra:array[1..20] of real;
buf:tochki;
begin
for i:=1 to n1 do
ra[i]:=rast(t1[i].x,t1[i].y);
p:=1;
for i:=1 to n1-1 do
if ra[i]>ra[i+1] then p:=0;
if p=0 then m1:=0
else m1:=1;
if p=0 then
for i:=1 to n1-1 do begin
for j:=1 to n1-i do
if rast(t[j].x,t[j].y)>rast(t[j+1].x,t[j+1] .y) then begin
buf.x:=t[j].x;
buf.y:=t[j].y;
t[j].x:=t[j+1].x;
t[j].y:=t[j+1].y;
t[j+1].x:=buf.x;
t[j+1].y:=buf.y;
end;
end;
end;
begin {osn programma}
writeln('Vvedite kol-vo tochek');
readln(n);
vvod(n,t);
proverka(n,m,t);
if m=0 then writeln('Net. Ots. massiv: ');
vivod(n,t);
if m=1 then writeln('DA');
readln;
end.
Занести в другой массив записей прямоугольные треугольники. Даны в записи их стороны
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils;
type zap=record
AB:integer;
BC:integer;
AC:integer;
end;
tre=array[1..20] of zap;
procedure VVOD (var a:tre;var n:integer);
var i:integer;
begin
writeln('Vvedite kolichestvo treygolnikov');
readln(n);
for i:=1 to n do begin
writeln('Vvedite storonu AB');
readln(a[i].AB);
writeln('Vvedite storonu BC');
readln(a[i].BC);
writeln('Vvedite storonu AC');
readln(a[i].AC);
end;
end;
procedure VIBOR(a:tre;n:integer;var b:tre;var k:integer);
var i:integer;
begin
k:=0;
for i:=1 to n do if
(sqr(a[i].AC)=sqr(a[i].AB)+sqr(a[i].BC))
or (sqr(a[i].AB)=sqr(a[i].AC)+sqr(a[i].BC))
or (sqr(a[i].BC)=sqr(a[i].AB)+sqr(a[i].AC)) then begin
k:=k+1;
b[k]:=a[i];
end;
end;
procedure VIVOD(b:tre;k:integer);
var i:integer;
begin
writeln('AB BC AC');
for i:=1 to k do writeln(b[i].AB,' ',b[i].BC,' ',b[i].AC);
end;
var A,C:tre;
n,k:integer;
begin
VVOD(A,n);
VIBOR(A,n,C,k);
writeln('Priamoygolnie treygolniki');
VIVOD(C,k);
readln;
end.
program studenti;
{$APPTYPE CONSOLE}
uses
SysUtils;
type stud=record
fam:string[20];
imia:string[20];
curs:1..6;
end;
studmas=array[1..25] of stud;
var st:studmas;
n,i,j:integer;
buf:stud;
begin
writeln('Vvedite kolichestvo studentov');
readln(n);
for i:=1 to n do begin
writeln('Vvedite famaliu');
readln(st[i].fam);
writeln('Vvedite imia');
readln(st[i].imia);
writeln('Vvedite curs');
readln(st[i].curs);
end;
writeln;
writeln('Isxodnie dannie');
writeln('Familia Imia Kurs ');
for i:=1 to n do
writeln(st[i].fam,' ',st[i].imia,' ',st[i].curs);
{Массив студентов по алфавиту}
writeln;
writeln('Studenti po alfavitu');
for j:=1 to n-1 do
for i:=1 to n-j do
if st[i].fam>st[i+1].fam then begin
buf:=st[i];
st[i]:=st[i+1];
st[i+1]:=buf;
end;
writeln('Familia Imia Kurs');
for i:=1 to n do writeln(st[i].fam,' ',st[i].imia,' ',st[i].curs);
readln;
end.
program studenti;
{$APPTYPE CONSOLE}
uses
SysUtils;
type stud=record
fam:string[20];
imia:string[20];
ball:integer;
end;
studmas=array[1..25] of stud;
procedure VVOD(var st:studmas;var n:integer);
var i:integer;
begin
writeln('Vvedite kolichestvo studentov');
readln(n);
for i:=1 to n do begin
writeln ('Vvedite familiu');
readln(st[i].fam);
writeln('Vvedite imia');
readln(st[i].imia);
writeln('Srednii ball');
readln(st[i].ball);
end;
end;
procedure SORT (var st:studmas;n:integer);
var i,j:integer;
buf:stud;
begin
for j:=1 to n-1 do
for i:=1 to n-j do
if st[i].fam>st[i+1].fam then begin
buf:=st[i];
st[i]:=st[i+1];
st[i+1]:=buf;
end;
end;
procedure VIVOD (st:studmas;n:integer);
var i:integer;
begin
writeln('Familia Imia Srednii ball');
for i:=1 to n do writeln (st[i].fam,' ',st[i].imia,' ',st[i].ball);
end;
procedure VISHII (st:studmas;n:integer;var max:studmas;var k:integer);
var i,m:integer;
begin
m:=st[1].ball;
for i:=1 to n do
if st[i].ball>m then m:=st[i].ball;
k:=0;
for i:=1 to n do
if st[i].ball=m then begin
k:=k+1;
max[k]:=st[i];
end;
end;
var st,max:studmas;
n,k:integer;
begin
VVOD(st,n);
SORT(st,n);
VIVOD(st,n);
VISHII(st,n,max,k);
writeln('Spisok luchix');
VIVOD(max,k);
readln;
end.