Создать массив из 20 элементов,хранящих информацию о студенках факультета.Каждый элемент содержит фамилию,курс,форму обучения,(специалист,бакалавр,магис тр)и оценки по 5 предметам за последнюю сессию.
Упорядочить массив по среднему баллу.Осуществить перевод студентов на следующий курс.Переводятся студенты ,не имеющие задолжностей за последнюю сессию,студенты 5-ого курса(специалисты) и 6-ого курса(магистры)должны быть удалены ,как окончившие курс обучения.
Я сделала,но явно неправильно,и кое где несообразила,как дальше.помогите исправить ошибки и дописать то,что совсем неверно.буду очень благодарна!
Окей,поможем, давайте только вы скажете,что именно не работает, что не можете придумать.
Еще я не улавливаю смысла делать в record еще один record.И еще 1 вопрос:"Вы используете Builder?"
Насчет процедуры form;
for i:=1 to n do
readln(b.pred[j]);
a[i]:=b
for i:=1 to n do
readln(b.pred[j]);
a[i]:=b
Давайте не лезть вперед паровоза,у вас и без удаления много ошибок,щас будем потихоньку разгребать.Кстати скажите,что за компилятор вы используете?
Значит так,начнем разбор полетов.
Tballs=array[1..5]of 1..5;
for i:=1 to n do
begin
readln(b.balls[j]);
s:=s+b.balls[j]
end;
b.med_ball:=s/5;
a[i]:=b
end;
const n=3;
const m=3;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] of 1..5;
telem=record
FIO:string[35];
curs: integer;
f_study:formob;
balls:Tballs;
Med_ball:real;
end;
tmas=array [1..n] of telem;
function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;
procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;
procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;
procedure sort(var b:tmas);
var
i,j:integer;
tmp:telem;
begin
for j:=1 to N-1 do
for i:=1 to N-j do
if (b[i].med_ball > b[i+1].med_ball) then
swap(b[i],b[i+1]);
end;
var
a:tmas;
mn,i:integer;
exit_:char;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
{Dvoechnik(d); }
Writeln('Перевод на следующий курс');
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.
Tballs=array[1..5]of 1..5;
for i:=1 to n do
begin
readln(b.balls[j]);
s:=s+b.balls[j]
end;
b.med_ball:=s/5;
a[i]:=b
end;
const n=3;
const m=3;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] of 1..5;
telem=record
FIO:string[35];
curs: integer;
f_study:formob;
balls:Tballs;
Med_ball:real;
end;
tmas=array [1..n] of telem;
function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;
procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;
procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;
procedure sort(var b:tmas);
var
i,j:integer;
tmp:telem;
begin
for j:=1 to N-1 do
for i:=1 to N-j do
if (b[i].med_ball > b[i+1].med_ball) then
swap(b[i],b[i+1]);
end;
var
a:tmas;
mn,i:integer;
exit_:char;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
{Dvoechnik(d); }
Writeln('Перевод на следующий курс');
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.
Тут есть 2 варианта,либо сначала повысить всем,а потом удалить тех кто привысил лимит, либо повыщать только тем,кто не заканчикает универ, а остальных сразу удалять.
Вот пример второго варианта, осталось только функцию удаления написать)
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) or ((a[i].f_study=spez) and (a[i].curs<5)) or ((a[i].f_study=bacal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,i);
end;
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) or ((a[i].f_study=spez) and (a[i].curs<5)) or ((a[i].f_study=bacal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,i);
end;
Ненене, ты что то перемудрила.))
procedure LevelUp(var a: tmas;p:integer);
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) or ((a[i].f_study=spez) and (a[i].curs<5)) or ((a[i].f_study=bacal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
procedure Otchislenie(var a: tmas;p:integer);
var
i:integer;
begin
for i:=n downto 1 do
if a[i]<3 then
Delete(a,n,i);
end;
procedure Delete(var a:tmas;var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n do
a[j-1]:=a[j];
p:=p+1;
end
else
p:=p+1;
end;
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
procedure LevelUp(var a: tmas;p:integer);
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) or ((a[i].f_study=spez) and (a[i].curs<5)) or ((a[i].f_study=bacal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
procedure Otchislenie(var a: tmas;p:integer);
var
i:integer;
begin
for i:=n downto 1 do
if a[i]<3 then
Delete(a,n,i);
end;
procedure Delete(var a:tmas;var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n do
a[j-1]:=a[j];
p:=p+1;
end
else
p:=p+1;
end;
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
Эх окей))
const n=3;
const m=2;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] of 1..5;
telem=record
FIO:string[35];
curs: integer;
f_study:formob;
balls:Tballs;
Med_ball:real;
end;
tmas=array [1..n] of telem;
function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;
procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;
procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;
procedure sort(var b:tmas);
var
i,j:integer;
tmp:telem;
begin
for j:=1 to N-1 do
for i:=1 to N-j do
if (b[i].med_ball > b[i+1].med_ball) then
swap(b[i],b[i+1]);
end;
procedure Delete(var a:tmas; var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n-p do
a[j-1]:=a[j];
end;
p:=p+1;
end;
function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
LevelUp:=p;
end;
function Otchislenie(var a: tmas;p:integer):integer;
var
flag:boolean;
i,j:integer;
begin
flag:=false;
for i:=n downto 1 do
begin
for j:=1 to m do
begin
if (a[i].balls[j]<3) then
begin
flag:=true;
break;
end;
end;
if (flag=true) then
Delete(a,p,i);
end;
Otchislenie:=p;
end;
var
a:tmas;
mn,i:integer;
exit_:char;
p:integer;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
p:=0;
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
p:=LevelUp(a,p);
p:=Otchislenie(a,p);
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.
const n=3;
const m=2;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] of 1..5;
telem=record
FIO:string[35];
curs: integer;
f_study:formob;
balls:Tballs;
Med_ball:real;
end;
tmas=array [1..n] of telem;
function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;
procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;
procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;
procedure sort(var b:tmas);
var
i,j:integer;
tmp:telem;
begin
for j:=1 to N-1 do
for i:=1 to N-j do
if (b[i].med_ball > b[i+1].med_ball) then
swap(b[i],b[i+1]);
end;
procedure Delete(var a:tmas; var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n-p do
a[j-1]:=a[j];
end;
p:=p+1;
end;
function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
LevelUp:=p;
end;
function Otchislenie(var a: tmas;p:integer):integer;
var
flag:boolean;
i,j:integer;
begin
flag:=false;
for i:=n downto 1 do
begin
for j:=1 to m do
begin
if (a[i].balls[j]<3) then
begin
flag:=true;
break;
end;
end;
if (flag=true) then
Delete(a,p,i);
end;
Otchislenie:=p;
end;
var
a:tmas;
mn,i:integer;
exit_:char;
p:integer;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
p:=0;
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
p:=LevelUp(a,p);
p:=Otchislenie(a,p);
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.
const n=3;
const m=2;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] of 1..5;
telem=record
FIO:string[35];
curs: integer;
f_study:formob;
balls:Tballs;
Med_ball:real;
end;
tmas=array [1..n] of telem;
function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;
procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;
procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;
procedure sort(var b:tmas);
var
i,j:integer;
tmp:telem;
begin
for j:=1 to N-1 do
for i:=1 to N-j do
if (b[i].med_ball > b[i+1].med_ball) then
swap(b[i],b[i+1]);
end;
procedure Delete(var a:tmas; var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n-p do
a[j-1]:=a[j];
end;
p:=p+1;
end;
function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
LevelUp:=p;
end;
function Otchislenie(var a: tmas;p:integer):integer;
var
flag:boolean;
i,j:integer;
begin
flag:=false;
for i:=n downto 1 do
begin
for j:=1 to m do
begin
if (a[i].balls[j]<3) then
begin
flag:=true;
break;
end;
end;
if (flag=true) then
Delete(a,p,i);
end;
Otchislenie:=p;
end;
var
a:tmas;
mn,i:integer;
exit_:char;
p:integer;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
p:=0;
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
p:=LevelUp(a,p);
p:=Otchislenie(a,p);
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.
Вы уж извините,но копаться в том,что вы изменили я не стал, я взял,что сам сделал и изменил.
const n=3;
const m=2;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] of 1..5;
telem=record
FIO:string[35];
curs: integer;
f_study:formob;
balls:Tballs;
Med_ball:real;
end;
tmas=array [1..n] of telem;
function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;
procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;
procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;
procedure sort(var b:tmas);
var
i,j:integer;
tmp:telem;
begin
for j:=1 to N-1 do
for i:=1 to N-j do
if (b[i].med_ball > b[i+1].med_ball) then
swap(b[i],b[i+1]);
end;
procedure Delete(var a:tmas; var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n-p do
a[j-1]:=a[j];
end;
p:=p+1;
end;
function Dvoechnik(var a: telem):boolean;
var
flag:boolean;
i,j:integer;
begin
flag:=false;
for j:=1 to m do
begin
if (a.balls[j]<3) then
begin
flag:=true;
break;
end;
end;
Dvoechnik:=flag;
end;
function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
LevelUp:=p;
end;
var
a:tmas;
mn,i:integer;
exit_:char;
p:integer;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
p:=0;
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
p:=LevelUp(a,p);
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.
const n=3;
const m=2;
type
formob=(spez,bakal,magis);
Tballs=array[1..m] of 1..5;
telem=record
FIO:string[35];
curs: integer;
f_study:formob;
balls:Tballs;
Med_ball:real;
end;
tmas=array [1..n] of telem;
function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Sorting');
writeln (' ','2.Up');
writeln (' ','3.Exit');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;
procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('FIO');
readln(b.FIO);
writeln('Number of Form Educationя');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Kurs');
readln(b.curs);
writeln('Marks');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;
procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;
procedure sort(var b:tmas);
var
i,j:integer;
tmp:telem;
begin
for j:=1 to N-1 do
for i:=1 to N-j do
if (b[i].med_ball > b[i+1].med_ball) then
swap(b[i],b[i+1]);
end;
procedure Delete(var a:tmas; var p:integer ; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n-p do
a[j-1]:=a[j];
end;
p:=p+1;
end;
function Dvoechnik(var a: telem):boolean;
var
flag:boolean;
i,j:integer;
begin
flag:=false;
for j:=1 to m do
begin
if (a.balls[j]<3) then
begin
flag:=true;
break;
end;
end;
Dvoechnik:=flag;
end;
function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
LevelUp:=p;
end;
var
a:tmas;
mn,i:integer;
exit_:char;
p:integer;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
p:=0;
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
p:=LevelUp(a,p);
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.
function Dvoechnik(var a: telem):boolean;
var
j: integer;
begin
Dvoechnik := True;
for j:=1 to m do
begin
if (a.balls[j]<3) then Exit
end;
Dvoechnik := False;
end;
Странный у вас преподаватель.
break - это функция прерывания цикла до его завершения по условию. Если у нас нет необходимости проходить цикл,а мы идем до первого появления чего-нибудь,то это экономит время,уменьшая время работы программы.Без него можно обходиться,как продемонстрировал IUnknown, но для этого пришлось пораскинуть мозгами, по крайней мере мне точно. И не всегда от него так просто избавиться.
Да я допустил маленькую ошибочку,bеgin еnd не расставил, щас просто программирую больше на дугом языке.
function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
begin
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1;
end
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
begin
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1;
end
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
begin
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
end
else
Delete(a,p,i);
end;
end;
end;
LevelUp:=p;
end;
if ((a[i].f_study=spez) and (a[i].curs<5)) then
if ((a[i].f_study=spez) and (a[i].curs<=5)) then
function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
begin
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1;
end
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
begin
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1;
end
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
begin
if not Dvoechnik(a[i]) then
a[i].curs:=a[i].curs+1
end
else
Delete(a,p,i);
end;
end;
end;
LevelUp:=p;
end;
Окей. Тогда вынесем проверку на двоечника вперед,чтобы в случае чего вообще не рассматривать проверку на специальность и курс.
function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if not Dvoechnik(a[i]) then
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
end;
LevelUp:=p;
end;
function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if not Dvoechnik(a[i]) then
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
end;
LevelUp:=p;
end;
Показывай твой код потому что у мня не переводит......
Девушка, либо я дурак,либо что-то тут не так,но вот смотрите, вот что я запускаю.
const n=3; {кол во студентов }
const m=2; {//кол-во предметов }
type
formob=(spez,bakal,magis);
Tballs=array[1..m] of 1..5;
telem=record
FIO:string[35];
curs: integer;
f_study:formob;
balls:Tballs;
Med_ball:real;
end;
tmas=array [1..n] of telem;
function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Сортировка');
writeln (' ','2.Перевод на следующий курс');
writeln (' ','3.Выход');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;
procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('ФИО');
readln(b.FIO);
writeln('Номер формы обучения(1.специалист 2. бакалавр 3. магистр)');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Курс');
readln(b.curs);
writeln('Оценка');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;
procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;
procedure sort(var b:tmas);
var
i,j:integer;
tmp:telem;
begin
for j:=1 to N-1 do
for i:=1 to N-j do
if (b[i].med_ball > b[i+1].med_ball) then
swap(b[i],b[i+1]);
end;
procedure Delete(var a:tmas; var p:integer; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n-p do
a[j-1]:=a[j];
end;
p:=p+1;
end;
function Dvoechnik(var a: telem):boolean;
var
flag:boolean;
i,j:integer;
begin
flag:=false;
for j:=1 to m do
begin
if (a.balls[j]<3) then
begin
flag:=true;
end;
end;
Dvoechnik:=flag;
end;
function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if not Dvoechnik(a[i]) then
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
end;
LevelUp:=p;
end;
var
a:tmas;
mn,i:integer;
exit_:char;
p:integer;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
p:=0;
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
p:=LevelUp(a,p);
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].curs);
end;
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.
const n=3; {кол во студентов }
const m=2; {//кол-во предметов }
type
formob=(spez,bakal,magis);
Tballs=array[1..m] of 1..5;
telem=record
FIO:string[35];
curs: integer;
f_study:formob;
balls:Tballs;
Med_ball:real;
end;
tmas=array [1..n] of telem;
function menu :integer;
var
choice:integer;
error_in: boolean;
begin
writeln;
writeln (' ','1.Сортировка');
writeln (' ','2.Перевод на следующий курс');
writeln (' ','3.Выход');
error_in:=false;
repeat
write ('Choice: ');
readln (choice);
error_in:=(choice<1) or (choice >3);
if error_in then
writeln ('Error!')
until not error_in;
menu:=choice;
end;
procedure Add (var a:telem);
var
k,i:integer;
b:telem;
s:integer;
begin
writeln('ФИО');
readln(b.FIO);
writeln('Номер формы обучения(1.специалист 2. бакалавр 3. магистр)');
readln(k);
case k of
1: b.f_study:=spez;
2: b.f_study:=bakal;
3: b.f_study:=magis
end;
writeln('Курс');
readln(b.curs);
writeln('Оценка');
s:=0;
for i:=1 to m do
begin
readln(b.balls[i]);
s:=s+b.balls[i];
end;
b.med_ball:=s/m;
a:=b;
end;
procedure swap(var x,y: telem);
var
t: telem;
begin
t := x;
x := y;
y := t
end;
procedure sort(var b:tmas);
var
i,j:integer;
tmp:telem;
begin
for j:=1 to N-1 do
for i:=1 to N-j do
if (b[i].med_ball > b[i+1].med_ball) then
swap(b[i],b[i+1]);
end;
procedure Delete(var a:tmas; var p:integer; i:integer);
var
j:integer;
begin
if i<n then
begin
for j:=i+1 to n-p do
a[j-1]:=a[j];
end;
p:=p+1;
end;
function Dvoechnik(var a: telem):boolean;
var
flag:boolean;
i,j:integer;
begin
flag:=false;
for j:=1 to m do
begin
if (a.balls[j]<3) then
begin
flag:=true;
end;
end;
Dvoechnik:=flag;
end;
function LevelUp(var a: tmas; p:integer):integer;
var
i:integer;
begin
for i:=n downto 1 do
begin
if not Dvoechnik(a[i]) then
begin
if ((a[i].f_study=magis) and (a[i].curs<6)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=spez) and (a[i].curs<5)) then
a[i].curs:=a[i].curs+1
else
begin
if ((a[i].f_study=bakal) and (a[i].curs<4)) then
a[i].curs:=a[i].curs+1
else
Delete(a,p,i);
end;
end;
end;
end;
LevelUp:=p;
end;
var
a:tmas;
mn,i:integer;
exit_:char;
p:integer;
begin
for i:=1 to n do
Add(a[i]);
writeln;
REPEAT
p:=0;
mn:=Menu;
case mn of
1:begin
sort(a);
for i:=1 to n do
begin
write(a[i].FIO+' ');
writeln(a[i].med_ball:4:4);
end;
end;
2: begin
p:=LevelUp(a,p);
for i:=1 to n-p do
begin
write(a[i].FIO+' ');
writeln(a[i].curs);
end;
end;
else
begin
writeln;
write (' ','Завершить работу? (Y/N)');
readln(exit_);
end;
end;
UNTIL (exit_='y') or (exit_='Y') or (mn=3);
readln;
end.
Блииииин, я столько работы зря проделал.
Девушка не глупите.
Он выводит не список тех кого переводит, а список ВСЕХ кто щас учится, я же дописал,чтобы выводило номер курса.Правильно, он выводит сидорова,потому что он не закончил обучение, он остался на том же курсе,что и был.
Выведите вместо средней оценки номер их курсов и все увидите.
Если не верите, то повысьте их еще на курс,если бы сидорова повышали на курс,то при втором повышении на курс он оканчивал бы обучение и был бы удален из списка.
Вы у меня спрашиваете?????Я условие в глаза не видел)))))))
Но если руководстоваться здравым смыслом.
Если студент сдает сессию без двоек, его переводят на слудующий курс, если курс последний для его формата обучения, то считается,что он закончил институт, то есть его удаляют из списка учащихся.
Если студент получает хотябы 1 двойку, то в реальной жизни есть несколько вариантов, первый, его отчисляют,что изначально я и сделал, вы сказали, что его не надо отчислять, это значит,что его оставляют на второй год,но студентом то он быть не перестает,следовательно из списка студентов не пропадает.
Понимаете, у вас не настолько хорошо структурированные данные.Если бы у вас для каждой специальности для каждого курса был свой собственный список студентов, тогда да это имело бы смысл,а так вы не выводите ни по курсам, ни по специальностям, какой смысл выводить тех,кто переведен,если люди с двойкой тоже являются студентами, просто их товарищи перешли на курс выше, а они остались.
Проще вывести всех,указав, что эти остались на 2 курсе, эти переведены на 3, эти на 4 и тд.
Конешно же можно было бы сделать подменю, сделать функцию,которая выводила бы всех студентов заданной специальности на определенном курсе,но каждый раз вбивать этот список,чтобы хотябы по 2-3 человека на каждой специальности хотябы на половине курсов........это порядка 15-20 человек. я точно не стану такое проверять.
То, что четко не обговорено в задании или преподавателем, в университете остается на рассмотрении того,кто выполняет задание, я больше чем уверен,если вы сможете обосновать то, почему вы сделали именно так,у вас примут задачу.
Конешно можно, но на мой взгляд это глупость несустветная.
2: begin
p:=LevelUp(a,p);
for i:=1 to n-p do
begin
if not Dvoechnik(a[i]) then
begin
write(a[i].FIO+' ');
writeln(a[i].curs);
end;
end;
end;
2: begin
p:=LevelUp(a,p);
for i:=1 to n-p do
begin
if not Dvoechnik(a[i]) then
begin
write(a[i].FIO+' ');
writeln(a[i].curs);
end;
end;
end;