Record и Строки

@irrm · Регистрация: 22.12.2009

Студворк — интернет-сервис помощи студентам

Здравствуйте.
я вроде как разобрался с задачей:
''На олимпиаде по информатике на школьников заполнялись анкеты: фамилия, номер школы, класс, занятое место. Напечатать:
1) списки школ, занявших призовые места;
2) какая из школ заняла больше всех призовых мест;
3) списки учеников занявших первое место, указать их класс''

попытался сделать сам, что то получилось что то нет =)

так вот я немного поискал и нашел решение.

Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Program Pascal; 
Uses crt; 
Const fname='students.dat'; 
n=5; {количество предметов за последнию сессию} 
Type st=record 
n_group:integer; {номер группы} 
n_sp:integer; {номер в группе по списку} 
fam:string; {фамилия} 
im:string; {имя} 
ot:string; {отчество} 
god_r:integer; {год рождения} 
oc:array [1..n] of integer;{оценки за последнию сессию} 
 
end; 
Var t:array[1..30] of st; 
i,ch,j:integer; 
h: file of st; 
 
 
begin 
 
write('Введите количество студентов в группе: '); readln(ch); 
 
 
for i:=1 to ch do begin 
writeln('Сведения о ' ,i,' студенте'); 
write('Номер группы: '); readln(t[i].n_group); 
write('Номер в группе по списку: '); readln(t[i].n_sp); 
write('Фамилия: '); readln(t[i].fam); 
write('Имя: '); readln(t[i].im); 
write('Отчество: '); readln(t[i].ot); 
write('Год рождения: '); readln(t[i].god_r); 
writeln('Оценки за последнию сессию: '); 
for j:=1 to n do begin 
case j of 
1:write('Математика: '); 
2:write('Физика: '); 
3:write('Химия: '); 
4:write('Культурология: '); 
5:write('История: '); 
end; 
readln(t[i].oc[j]); 
if not ((t[i].oc[j]>0) and (t[i].oc[j]<=5)) then begin 
writeln('Неверно введена оценка! Повторите ввод.'); 
j:=j-1; 
end; 
end; 
writeln; 
end; 
Assign (h,fname); 
{$I-} 
reset(h); 
If Ioresult<>0 then rewrite(h); 
{$I+} 
for i:=1 to ch do write(h,t[i]); 
 
close(h); 
writeln('Данные занесены в файл ',fname); 
readln; 
 
end.

не могли бы вы мне помочь подстроить эту задачу под мою?

я сам пытался делать получился откровенный бред =)

Добавлено через 3 часа 42 минуты
пожалуйста мне нужна ваша пощь :'(

@Puporev · 13.05.2010, 08:34

Вот принципиальное решение задачи. Ввод, вывод данных, интерфейс программы, это на Ваше усмотрение, это просто пример.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
uses crt;
const q=5;
      nom:array[1..q] of byte=(11,17,32,94,125);
type anketa=record
            fam:string[20];
            shk:byte;
            kls:byte;
            mst:byte;
            end;
var a:array[1..100] of anketa;
    n,i,j,k,p,imx,mx:byte;
begin
clrscr;
write('Количество участников олимпиады n=');
readln(n);
writeln('Введите сведения об участниках:');
for i:=1 to n do
 begin
  writeln('Участник ',i);
  with a[i] do
   begin
    write(' Фамилия: ');readln(fam);
    repeat
    writeln(' Номер школы 1-11 2-17 3-32 4-94 5-125');
    readln(k);
    until k in [1..5];
    shk:=nom[k];
    repeat
    write(' Класс (9-11): ');
    readln(kls);
    until kls in [9..11];
    repeat
    write(' Занятое место (1-10): ');
    readln(mst);
    until mst in [1..10];
   end;
 end;
writeln('Списки школ, занявших призовые места:');
k:=0;
for i:=1 to q do
 begin
  p:=0;
  for j:=1 to n do
  if(a[j].shk=nom[i])and(a[i].mst in [1..3]) then p:=1;
  if p=1 then
   begin
    k:=1;
    writeln('Школа № ',nom[i]);
   end;
 end;
if k=0 then writeln('Призовые места никому не присуждены!')
else
 begin
  mx:=1;
  imx:=1;
  for i:=1 to q do
   begin
    k:=0;
    for j:=1 to n do
    if(a[j].shk=nom[i])and(a[i].mst in [1..3]) then k:=k+1;
    if k>mx then
     begin
      mx:=k;
      imx:=i;
     end;
   end;
  writeln('Больше всех призовых мест заняла школа № ',nom[imx]);
  writeln('Списки учеников, занявших первые места:');
  for i:=1 to n do
  if a[i].mst=1 then writeln(a[i].fam,'  ',a[i].kls);
 end;
readln
end.

@irrm · 13.05.2010, 12:01 **[ТС]**

спасибо вам огромное!

@nezhensky · 11.01.2019, 11:42

Сообщение от Puporev

Вот принципиальное решение задачи.

Смысл понятен, но в коде нашёл ошибки есть мелкие.

@JuriiMW · 11.01.2019, 12:33

nezhensky, что-то я не нашёл…
Может не там искал?
Огласите весь список, пожалуйста!

@nezhensky · 11.01.2019, 12:57

Выделил жирным:
Program school;
const q=5;{Количество школ учавствующих в олимпиаде}
nom:array[1..q] of byte=(11,17,32,94,125);{Номера школ участвующих в олимпиаде}
type anketa=record{Имя комбинированного типа}
fam:string[20];{фамилия ученика}
shk:byte;{номер школы}
kls:byte;{класс ученика}
mst:byte;{занятое место}
end;
var a:array[1..100] of anketa;{Массив анкет школьников}
n,i,j,imx,mx:byte;
k,p:byte;{Флаги проверки условий}
begin
write('Количество участников олимпиады n=');
readln(n);
writeln('Введите сведения об участниках:');
for i:=1 to n do {Цикл ввода анкет}
begin
writeln('Участник ',i);
with a[i] do
begin
write(' Фамилия: ');readln(fam);
repeat
writeln(' Номер школы (введите 1 для №11, 2 для №17, 3-№32, 4-№94, 5-№125)');
readln(k);
until k in [1..q];
shk:=nom[k];
repeat
write(' Класс (9-11): ');
readln(kls);
until kls in [9..11];
repeat
write(' Занятое место (1-10): ');
readln(mst);
until mst in [1..10];
end;
writeln;
end;
writeln('1. Списки школ, занявших призовые места:');
k:=0;
for i:=1 to q do{Цикл по школам}
begin
p:=0;
for j:=1 to n do{Цикл по анкетам}
{Проверка условий}
if (a[j].shk=nom[i]) and (a[j].mst in [1..3]) then p:=1;{При условии ставим флаг p}
{занятое место ученика от 1 до 3}
if p=1 then {Если флаг p=1, выводим школу}
begin
k:=1;{Хоть одна школа попала в список, то ставим флаг k=1}
writeln('Школа № ',nom[i]);
end;
end;
{Если флаг k не появился =1}
if k=0 then writeln('Призовые места никому не присуждены!')
else
begin
mx:=0;
imx:=0;
for i:=1 to q do {Цикл по школам}
begin
k:=0;
for j:=1 to n do {Цикл по анкетам}
if(a[j].shk=nom[i])and(a[j].mst in [1..3]) then k:=k+1;{Считаем кол-во мест от 1 до 3, по каждой школе}
if k>mx then{Поиск максимального значения по спискам школ}
{Если кол-во мест превышает по прошлой посчитаной школе, запоминаем её mx кол-во мест}
begin
mx:=k;
imx:=i;
end;
end;
writeln('2. Больше всех призовых мест заняла школа № ',nom[imx]);
writeln('3. Списки учеников, занявших первые места:');
for i:=1 to n do
{проверка условия/ если занятое место=1}
if a[i].mst=1 then writeln(a[i].fam,' класс: ',a[i].kls);
end;
writeln('Нажмите ENTER для выхода...');
readln
end.

@JuriiMW · 11.01.2019, 15:03

Дык, вы про решение ТС!
А на счёт его „корявости“ кто бы сомневался?
Ведь он „нашёл“ решение, а не написал программу!!!

Новые блоги и статьи Все статьи Все блоги /
Программная установка даты и запрет ее изменения Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: при создании документов установить период списания автоматически. . .	Вывод данных в справочнике через динамический список Maks 01.04.2026 Реализация из решения ниже выполнена на примере нетипового справочника "Спецтехника" разработанного в конфигурации КА2. Задача: вывести данные из ТЧ нетипового документа. . .	Функция заполнения текстового поля в реквизите формы документа Maks 01.04.2026 Алгоритм из решения ниже реализован на нетиповом документе "ВыдачаОборудованияНаСпецтехнику" разработанного в конфигурации КА2, в дополнении к предыдущему решению. На форме документа создается. . .	К слову об оптимизации kumehtar 01.04.2026 Вспоминаю начало 2000-х, университет, когда я писал на Delphi. Тогда среди программистов на форумах активно обсуждали аккуратную работу с памятью: нужно было следить за переменными, вовремя. . .
Идея фильтра интернета (сервер = слой+фильтр). Hrethgir 31.03.2026 Суть идеи заключается в том, чтобы запустить свой сервер, о чём я если честно мечтал давно и давно приобрёл книгу как это сделать. Но не было причин его запускать. Очумелые учёные напечатали на. . .	Модель здравосоХранения 6. ESG-повестка и устойчивое развитие; углублённый анализ кадрового бренда anaschu 31.03.2026 В прикрепленном документе раздумья о том, как можно поменять модель в будущем	10 пpимет, которые всегда сбываются Maks 31.03.2026 1. Чтобы, наконец, пришла маршрутка, надо закурить. Если сигарета последняя, маршрутка придет еще до второй затяжки даже вопреки расписанию. 2. Нaдоели зима и снег? Не надо переезжать. Достаточно. . .	Перемещение выделенных строк ТЧ из одного документа в другой Maks 31.03.2026 Реализация из решения ниже выполнена на примере нетипового документа "ВыдачаОборудованияНаСпецтехнику" с единственной табличной частью "ОборудованиеИКомплектующие" разработанного в конфигурации КА2. . . .

@irrm 0 / 0 / 1 Регистрация: 22.12.2009 Сообщений: 6
	13.05.2010, 12:01 [ТС]
	спасибо вам огромное! 0

@JuriiMW 5095 / 2661 / 2355 Регистрация: 10.12.2014 Сообщений: 10,060
	11.01.2019, 12:33
	nezhensky, что-то я не нашёл… Может не там искал? Огласите весь список, пожалуйста! 0

@nezhensky 125 / 115 / 16 Регистрация: 26.04.2012 Сообщений: 342 Записей в блоге: 3
	11.01.2019, 12:57
	Выделил жирным: Program school; const q=5;{Количество школ учавствующих в олимпиаде} nom:array[1..q] of byte=(11,17,32,94,125);{Номера школ участвующих в олимпиаде} type anketa=record{Имя комбинированного типа} fam:string[20];{фамилия ученика} shk:byte;{номер школы} kls:byte;{класс ученика} mst:byte;{занятое место} end; var a:array[1..100] of anketa;{Массив анкет школьников} n,i,j,imx,mx:byte; k,p:byte;{Флаги проверки условий} begin write('Количество участников олимпиады n='); readln(n); writeln('Введите сведения об участниках:'); for i:=1 to n do {Цикл ввода анкет} begin writeln('Участник ',i); with a[i] do begin write(' Фамилия: ');readln(fam); repeat writeln(' Номер школы (введите 1 для №11, 2 для №17, 3-№32, 4-№94, 5-№125)'); readln(k); until k in [1..q]; shk:=nom[k]; repeat write(' Класс (9-11): '); readln(kls); until kls in [9..11]; repeat write(' Занятое место (1-10): '); readln(mst); until mst in [1..10]; end; writeln; end; writeln('1. Списки школ, занявших призовые места:'); k:=0; for i:=1 to q do{Цикл по школам} begin p:=0; for j:=1 to n do{Цикл по анкетам} {Проверка условий} if (a[j].shk=nom[i]) and (a[j].mst in [1..3]) then p:=1;{При условии ставим флаг p} {занятое место ученика от 1 до 3} if p=1 then {Если флаг p=1, выводим школу} begin k:=1;{Хоть одна школа попала в список, то ставим флаг k=1} writeln('Школа № ',nom[i]); end; end; {Если флаг k не появился =1} if k=0 then writeln('Призовые места никому не присуждены!') else begin mx:=0; imx:=0; for i:=1 to q do {Цикл по школам} begin k:=0; for j:=1 to n do {Цикл по анкетам} if(a[j].shk=nom[i])and(a[j].mst in [1..3]) then k:=k+1;{Считаем кол-во мест от 1 до 3, по каждой школе} if k>mx then{Поиск максимального значения по спискам школ} {Если кол-во мест превышает по прошлой посчитаной школе, запоминаем её mx кол-во мест} begin mx:=k; imx:=i; end; end; writeln('2. Больше всех призовых мест заняла школа № ',nom[imx]); writeln('3. Списки учеников, занявших первые места:'); for i:=1 to n do {проверка условия/ если занятое место=1} if a[i].mst=1 then writeln(a[i].fam,' класс: ',a[i].kls); end; writeln('Нажмите ENTER для выхода...'); readln end. 0

@JuriiMW 5095 / 2661 / 2355 Регистрация: 10.12.2014 Сообщений: 10,060
	11.01.2019, 15:03
	Дык, вы про решение ТС! А на счёт его „корявости“ кто бы сомневался? Ведь он „нашёл“ решение, а не написал программу!!! 0

Record и Строки

Решение