IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Упорядочить массив по среднему баллу, задача на Записи
natik3
сообщение 21.05.2012 23:45
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Женский

Репутация: -  0  +


Создать массив из 20 элементов,хранящих информацию о студенках факультета.Каждый элемент содержит фамилию,курс,форму обучения,(специалист,бакалавр,магис тр)и оценки по 5 предметам за последнюю сессию.
Упорядочить массив по среднему баллу.Осуществить перевод студентов на следующий курс.Переводятся студенты ,не имеющие задолжностей за последнюю сессию,студенты 5-ого курса(специалисты) и 6-ого курса(магистры)должны быть удалены ,как окончившие курс обучения.
Я сделала,но явно неправильно,и кое где несообразила,как дальше.помогите исправить ошибки и дописать то,что совсем неверно.буду очень благодарна!

Код

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

const n=5;
type
formob=(spez,bakal,magis);
zmas=array [1..5]of integer;
telem=record
name:record
FIO:string[30]
curs: 1..6;
end;
pred:zmas;
form:formob;
end;
tmas=array [1..n] of telem;
var
a:tmas;
b:array[1..n]of string[30];// массив студентов,которых переводят
mn,choice,i:Integer;
  exit_:char;
  error_in: boolean;
Function menu :integer; //Вывод меню на экран
begin
    writeln;
    writeln (' ','1.Упорядочить массив по среднему баллу');
    writeln (' ','2.Перевести студентов на следующих курс');
    Writeln (' ','3.Завершение работы.');
    repeat
      write ('Ваш выбор: ');
      readln (choice);
      error_in:=(choice<1) or (choice >3);
      if error_in then writeln ('Ошибка ввода!')
    until not error_in;
    menu:=choice;
end;


procedure form (var a:tmas);
var
k,i,j:integer;
b:telem;
n:integer;
tmp:telem;
begin
  writeln('Ввести ФИО');
  readln(b.name.FIO);
  writeln('Ввести номер формы обучения');
  readln(k);
  case k of
    1: b.form:=spez;
    2: b.form:=bakal;
    3: b.form:=magis
  end;
  writeln('Ввести курс');
  readln(b.name.curs);
  writeln('Ввести оценки');
   for i:=1 to n do
  readln(b.pred[j]);
  a[i]:=b
   end;

Function Sr(b:zmas):integer;
  var
   s1,s,i:integer;
    begin
      S:=0;
      for i:=1 to n do
      begin
        S:=S+S1(b[i].pred);
        Sr:=s1 div 5
      end;
      end;

   procedure sort(var b:tmas);
var
i,j:integer;
tmp:telem;
begin
   for i:=1 to n do
  if(b[i]>b[i+1]) then
    begin
      tmp:=b[i];
      b[i]:=b[i+1];
      b[i+1]:=tmp;
    end;
end;
Procedure perevod (var b:tmas);
var i,k:integer;
i:=1; k:=0;
while  i<= n-k do
//---------------------
Function Dvoechnik (a:tmas);
var i,k:integer;
  for i:=1 to n do
    Begin
      If a[i]<3 then
         k:=k+1
    end;
//---------------------





   SetConsoleOutputCP(1251);
  form(а);
  writeln;
  REPEAT
    mn:=Menu;
    case mn of
     1:begin
          sort(а);

       end;
     2: begin
          Writeln('Перевод на следующий курс');

        end
     end;
    if mn<>3 then
        begin
          Writeln;
          write (' ','Завершить работу? (Y/N)');
          readln(exit_);
        end;
  UNTIL (exit_='y') or (exit_='Y') or (choice=3);
  readln

End.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
Krjuger
сообщение 4.06.2012 22:42
Сообщение #2


Профи
****

Группа: Пользователи
Сообщений: 652
Пол: Мужской
Реальное имя: Алексей

Репутация: -  20  +


Показывай твой код потому что у мня не переводит......
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
natik3
сообщение 4.06.2012 22:47
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 34
Пол: Женский

Репутация: -  0  +


Цитата(Krjuger @ 4.06.2012 23:42) *

Показывай твой код потому что у мня не переводит......

Код

program str155n10;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows;

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
setconsolecp(1251);
setconsoleoutputcp(1251);
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.

я ничего не меняла.только чтоб на русском выводилось и все
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
natik3   Упорядочить массив по среднему баллу   21.05.2012 23:45
Krjuger   Окей,поможем, давайте только вы скажете,что именно...   22.05.2012 10:58
natik3   Окей,поможем, давайте только вы скажете,что именн...   22.05.2012 12:32
Krjuger   Давайте не лезть вперед паровоза,у вас и без удале...   22.05.2012 13:26
natik3   Давайте не лезть вперед паровоза,у вас и без удал...   22.05.2012 13:56
Krjuger   Значит так,начнем разбор полетов. Tballs=array[1....   22.05.2012 14:23
natik3   Значит так,начнем разбор полетов. [code=pas] Tbal...   22.05.2012 16:45
Krjuger   Тут есть 2 варианта,либо сначала повысить всем,а п...   22.05.2012 17:17
natik3   Тут есть 2 варианта,либо сначала повысить всем,а ...   22.05.2012 17:29
Krjuger   Ненене, ты что то перемудрила.)) procedure LevelU...   22.05.2012 17:53
natik3   Ненене, ты что то перемудрила.)) procedure Level...   22.05.2012 18:02
Krjuger   Эх окей)) const n=3; const m=2; type formob=(...   22.05.2012 19:58
natik3   Эх окей)) const n=3; const m=2; type formob=...   22.05.2012 21:00
natik3   Эх окей)) [code=pas] const n=3; const m=2; type ...   3.06.2012 12:14
Krjuger   Вы уж извините,но копаться в том,что вы изменили ...   3.06.2012 13:43
natik3   Вы уж извините,но копаться в том,что вы изменили...   3.06.2012 14:25
IUnknown   function Dvoechnik(var a: telem):boolean; var j...   3.06.2012 14:37
Krjuger   Странный у вас преподаватель. break - это функция ...   3.06.2012 16:59
natik3   Странный у вас преподаватель. break - это функция...   4.06.2012 21:34
Krjuger   Да я допустил маленькую ошибочку,bеgin еnd не расс...   4.06.2012 21:59
natik3   Да я допустил маленькую ошибочку,bеgin еnd не рас...   4.06.2012 22:05
Krjuger   Окей. Тогда вынесем проверку на двоечника вперед,ч...   4.06.2012 22:26
natik3   Окей. Тогда вынесем проверку на двоечника вперед,...   4.06.2012 22:37
Krjuger   Показывай твой код потому что у мня не переводит.....   4.06.2012 22:42
natik3   Показывай твой код потому что у мня не переводит....   4.06.2012 22:47
Krjuger   Девушка, либо я дурак,либо что-то тут не так,но во...   4.06.2012 23:00
natik3   Девушка, либо я дурак,либо что-то тут не так,но в...   4.06.2012 23:08
Krjuger   Блииииин, я столько работы зря проделал. Девушка н...   4.06.2012 23:15
natik3   Блииииин, я столько работы зря проделал. Девушка ...   4.06.2012 23:26
Krjuger   Вы у меня спрашиваете?????Я условие в глаза не вид...   4.06.2012 23:34
natik3   Вы у меня спрашиваете?????Я условие в глаза не ви...   4.06.2012 23:37
Krjuger   Понимаете, у вас не настолько хорошо структурирова...   4.06.2012 23:51
natik3   Понимаете, у вас не настолько хорошо структуриров...   4.06.2012 23:56
natik3   Понимаете, у вас не настолько хорошо структуриров...   5.06.2012 0:02
Krjuger   То, что четко не обговорено в задании или преподав...   4.06.2012 23:58
Krjuger   Конешно можно, но на мой взгляд это глупость несус...   5.06.2012 0:09
natik3   Конешно можно, но на мой взгляд это глупость несу...   5.06.2012 0:17


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 20.07.2025 18:27
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"