Составить программу. Массивы - Паскаль, Turbo Pascal, PascalABC.NET

Katerina*** · 22.11.2012, 01:26

Ребятки программисты, помогите пожалуйста с информатикой!
Мне задали делать эти задачки, а информатики у меня в школе не было.
Вся надежда только на вас!

Вот в общем что нам задали:

Составить на языке Паскаль программу, управляющуюся с помощью меню.

В меню обязательно должны войти пункты:
1) ввод одномерного массива;
2) вывод одномерного массива ;
3) обработка одномерного массива (задача 1) с выдачей результатов;
4) обработка одномерного массива (задача 2) с выдачей результатов;
5) выход из программы (с подтверждением).

1.Определить, какой элемент – максимальный или первый нулевой (по порядку расположения в массиве) – стоит ближе к началу массива;

2. Определить, что больше – сумма элементов, стоящих до максимального элемента, или сумма элементов, стоящих после максимального элемента;

И еще, главное чтобы вывод значений был не рандомным! Это обязательное условие. (Как-то так нам сказал преподаватель)

Буду очень благодарна :*

Serge_Bliznykov · 22.11.2012, 09:14

Самый простой вариант меню - выдать список действий (с номерами) через WriteLn;
пользователь вводит номер нужного действия, программа проверяет, что он ввёл и выполняет соответствующую процедуру.
в коде это выглядит примерно так:

Код:

uses CRT;

procedure MasVvod;
begin
  WriteLn('Вы выбрали ввод значений в массив');
  Readln;
end;

procedure VyvodMas;
begin
  WriteLn('Вы выбрали вывод значений массива');
  Readln;
end;

var ct : char;
begin
  repeat
    ClrScr;
    WriteLn('Выберите действие:');
    writeln('1 - ввод одномерного массива');
    writeln('2 - вывод одномерного массива');
    writeln('3 - обработка одномерного массива (задача 1) с выдачей результатов');
    writeln('4 - обработка одномерного массива (задача 2) с выдачей результатов');
    writeln('5 - выход из программы (с подтверждением)');    
    Writeln('_________________________ ');
    repeat
      Write('Выш выбор: ');
      readln(ct);
    until ct in ['1'..'5'];

    case ct of
      '1' : MasVvod;
      '2' : VyvodMas;
      {
      '3' : .... ;
      '4' : .... ;
      }
      '5' : {запрос подтверждения} 
            begin
              WriteLn;
              Write('Вы действительно хотите выйти из программы? (Y/N) : ');
              ReadLn(ct);
              if (ct='Y') or (ct='y') then ct := '5'; 
                                  { возвращаем '5'-ку в переменную, по ней будет выход из цикла }
            end;      
    end;

  until ct = '5'; { выход из программы }

  WriteLn('Программа закончила работу. Bye!');
  ReadLn
end.

по поводу всего остального - начните решать, приводите тут свои наработки, Вам обязательно помогут..

Katerina*** · 23.11.2012, 01:02

Вот в общем что у меня получилось. Как эти задачки связать с меню? Ребят, срочно помогите, скоро информатика!

Задачка 1. (Но в ней ошибка, я устала уже делать, помогите исправить)

Код:

program b1;
var a:array[1..10] of integer;
n, nn, max, nmax, i:integer;
begin
        for i:=1 to 10 do
        read(a[i]);
        nmax:=0;
        nn:=0;
for i:=1 to 10 do
begin if (a[i]>max) then
nmax:=i;
        if (a[i]=0) then
        nn:=i;
        end;
if(nmax=0) then
nmax:=11;
if (nn=0) then
nn:=11;
if (nn<nmax) then
        writeln('Ближе к началу стоит нулевой элемент	);
 if (nn<nmax) then
        writeln('Ближе к началу стоит максимальный элемент');
        writeln('Первый нулевой и максимальный элементы стоят на одной позиции');
end.

2 Задачка:

Код:

program d2;
var a:array[1..10] of integer;
max, nmax, i, s1, s2:integer;
begin
for i:= 1 to 10 do
read(a[i]);
nmax:=0;
max:=a[i];
for i:=1 to 10 do
if(max<a[i]) then
begin
max:=a[i];
nmax:=i;
end;
        s1:=0;
        s2:=10;
        for i:=1 to nmax-1 do
        s1:=s1+a[i];
        if (s1>s2) then
        writeln('Сумма до максимального больше суммы после максимального');
        if (s1<s2) then
        writeln('‘Сумма до максимального меньше суммы после максимального')
        else
        writeln('‘Сумма до максимального и сумма после максимального равны');
end.

Xardas · 23.11.2012, 02:20

К задаче №1

Код:

begin
for i:=1 to 10 do
  read(a[i]);

nn:=-1; {если нулевого элемента нет, то сохраним -1}

for i:=1 to 10 do
if (a[i]=0) then
  begin
    nn:=i;
    break; {нашли первый нулевой, дальше искать не надо}
  end;

max:=a[10];

for i:=9 downto 1 do {downto, чтобы получить индекс первого максимального}
if (a[i]>=max) then
  begin  
      nmax:= i;
      max := a[i];
  end;

if (nn <> -1) and (nn < nmax) then
        writeln('Ближе к началу стоит нулевой элемент');

if (nn > nmax) or (nn = -1) then
        writeln('Ближе к началу стоит максимальный элемент');

if nn = nmax then
        writeln('Первый нулевой и максимальный элементы стоят на одной позиции');
end.

К задаче №2

Код:

begin
for i:= 1 to 10 do
  read(a[i]);

nmax:=0;
max := a[10];

{будем считать, что если максимальных несколько,
то за точку отсчета возьмем первый из них}

for i:=9 downto 1 do
  if(a[i] >= max) then
      begin
        nmax:=i;
        max := a[i];
      end;

s1:=0;
s2:=0;

for i:=1 to 10 do
  begin
    if (i < nmax) then
      s1 := s1 + a[i];
    if (i > nmax) then
      s2 := s2 + a[i];
  end;


if (s1 > s2) then
  writeln('Сумма до максимального больше суммы после максимального')
  else
    if (s1 < s2) then
        writeln('Сумма до максимального меньше суммы после максимального')
     else
        writeln('Сумма до максимального и сумма после максимального равны');
end.

А теперь возьмите код Serge_Bliznykov, где в case закомментированы строки '3' и '4', вставляйте в 3 код первой задачи, в 4 - код второй задачи. Лучше всего, если решение задач оформите в виде процедур, так же, как сделаны процедуры MasVvod и VyvodMas, тогда в case у Вас будут только вызовы этих процедур

Katerina*** · 23.11.2012, 02:27

Xardas
Вы очень хороший человек, спасибо вам огромнейшее! Так меня выручили.

Xardas · 23.11.2012, 02:32

Katerina***, не за что и спасибо на добром слове

Лучше потестируйте хорошо, потому что писалось на лету... мало ли...

Katerina*** · 23.11.2012, 02:59

Сейчас, занимаюсь. Если что не так, я здесь отпишусь обязательно =_

Katerina*** · 23.11.2012, 03:43

Ребятки, а не могли бы вы скинуть полностью как будет выглядеть моя программа, и главное, чтобы она запускалась.
Мучаюсь уже 5-ый час - не запускается.
(Иероглифы - не обращайте внимания на них)

Код:

Program CRT;
var
a,i:integer;
begin
procedure MasVvod;
begin
  WriteLn('‚л ўлЎа*«Ё ўў®¤ §**зҐ*Ё© ў ¬*ббЁў');
  Readln;
end;
procedure VyvodMas;
begin
  WriteLn('‚л ўлЎа*«Ё ўлў®¤ §**зҐ*Ё© ¬*ббЁў*');
  Readln;
end;
var ct : char;
begin
  repeat
    ClrScr;
    WriteLn('‚лЎҐаЁвҐ ¤Ґ©бвўЁҐ:');
    writeln('1 - ‚ў®¤ ®¤*®¬Ґа*®Ј® ¬*ббЁў*');
    writeln('2 - ‚лў®¤ ®¤*®¬Ґа*®Ј® ¬*ббЁў*');
    writeln('3 - ЋЎа*Ў®вЄ* ®¤*®¬Ґа*®Ј® ¬*ббЁў* 1');
    writeln('4 - ЋЎа*Ў®вЄ* ®¤*®¬Ґа*®Ј® ¬*ббЁў* 2');
    writeln('5 - ‚ле®¤ Ё§ Їа®Ја*¬¬л (б Ї®¤вўҐа¦¤Ґ*ЁҐ¬)');
    Writeln('_________________________ ');
    repeat
      Write('‚*и ўлЎ®а: ');
      readln(ct);
    until ct in ['1'..'5'];

    case ct of
      '1' : MasVvod;
      '2' : VyvodMas;
      '3' :  begin
for i:=1 to 10 do
  read(a[i]);

nn:=-1; }

for i:=1 to 10 do
if (a[i]=0) then
  begin
    nn:=i;
    break;
  end;

max:=a[10];

for i:=9 downto 1 do
if (a[i]>=max) then
  begin
      nmax:= i;
      max := a[i];
  end;

if (nn <> -1) and (nn < nmax) then
writeln('Ѓ«Ё¦Ґ Є **з*«г бв®Ёв *г«Ґў®© н«Ґ¬Ґ*в');

if (nn > nmax) then
writeln('Ѓ«Ё¦Ґ Є **з*«г бв®Ёв ¬*ЄбЁ¬*«м*л© н«Ґ¬Ґ*в');

if (nn = nmax) then
writeln('ЏҐаўл© *г«Ґў®© Ё ¬*ЄбЁ¬*«м*л© н«Ґ¬Ґ*вл бв®пв ** ®¤*®© Ї®§ЁжЁЁ');

end.
      '4' :
      begin
for i:= 1 to 10 do
  read(a[i]);

nmax:=0;
max := a[10];

for i:=9 downto 1 do
  if(a[i] >= max) then
      begin
        nmax:=i;
        max := a[i];
      end;

s1:=0;
s2:=0;

for i:=1 to 10 do
  begin
    if (i < nmax) then
      s1 := s1 + a[i];
    if (i > nmax) then
      s2 := s2 + a[i];
  end;


if (s1 > s2) then
  writeln('‘г¬¬* ¤® ¬*ЄбЁ¬*«м*®Ј® Ў®«миҐ бг¬¬л Ї®б«Ґ ¬*ЄбЁ¬*«м*®Ј®')
  else
    if (s1 < s2) then
        writeln('‘г¬¬* ¤® ¬*ЄбЁ¬*«м*®Ј® ¬Ґ*миҐ бг¬¬л Ї®б«Ґ ¬*ЄбЁ¬*«м*®Ј®')
     else
        writeln('‘г¬¬* ¤® ¬*ЄбЁ¬*«м*®Ј® Ё бг¬¬* Ї®б«Ґ ¬*ЄбЁ¬*«м*®Ј® а*ў*л');
      '5' : begin
              WriteLn;
              Write('‚л ¤Ґ©бвўЁвҐ«м*® е®вЁвҐ ўл©вЁ Ё§ Їа®Ја*¬¬л? (Y/N) : ');
              ReadLn(ct);
              if (ct='Y') or (ct='y') then ct := '5';

            end;
    end;

  until ct = '5';

  WriteLn('Џа®Ја*¬¬* §*Є®*зЁ«* а*Ў®вг. Bye!');
  ReadLn
  end;

___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

Poma][a · 23.11.2012, 07:23

Код:

type
    TArr = array [1..10000] of Integer;

procedure InitArr (var a : TArr; var n : Integer);

var
    i : Integer;

begin
    WriteLn ('Вы выбрали ввод массива');
    Write ('Введите размерность массива  '); ReadLn (n);

    for i := 1 to n do begin
        Write ('Введите  ', i, '-тый элемент массива  '); ReadLn (a[i])

    end
end;

procedure PrintArr (const a : TArr; const n : Integer);

var
    i : Integer;

begin
    WriteLn ('Вы выбрали вывод массива');
    for i := 1 to n do
        WriteLn (i, '-тый элемент равен ', a[i])

end;

procedure PosMaxOrZero (const a : TArr; const n : Integer);
var
    i, max, nn, nmax : Integer;
begin
    WriteLn ('Вы выбрали ..');

    nn:=-1; {если нулевого элемента нет, то сохраним -1}

    for i := 1 to n do
        if a[i] = 0 then begin
            nn:=i;
            break; {нашли первый нулевой, дальше искать не надо}
        end;

    max := a[n];

    for i := n downto 1 do {downto, чтобы получить индекс первого максимального}
    if a[i] >= max then begin
          nmax:= i;
          max := a[i];
    end;

    if (nn <> -1) and (nn < nmax) then
        writeln('Ближе к началу стоит нулевой элемент');

    if nn > nmax then
        writeln('Ближе к началу стоит максимальный элемент');

    if nn = nmax then
        writeln('Первый нулевой и максимальный элементы стоят на одной позиции');

end;

procedure PosingMaxSum (const a : TArr; const n : Integer);
var
    i, nmax, max, s1, s2 : Integer;
begin

    nmax:=0;
    max := a[n];

{будем считать, что если максимальных несколько,
то за точку отсчета возьмем первый из них}

    for i := n downto 1 do
        if(a[i] >= max) then begin
            nmax:=i;
            max := a[i];
        end;

    s1:=0;
    s2:=0;

    for i:= 1 to n do begin
    if i < nmax then
      s1 := s1 + a[i];
    if i > nmax then
      s2 := s2 + a[i];
  end;


    if s1 > s2 then
        writeln('Сумма до максимального больше суммы после максимального')
    else
    if (s1 < s2) then
        writeln('Сумма до максимального меньше суммы после максимального')
     else
        writeln('Сумма до максимального и сумма после максимального равны');
end;


var ct : char;
    a : TArr;
    n : Integer;

begin
  repeat
    WriteLn('Выберите действие:');
    writeln('1 - ввод одномерного массива');
    writeln('2 - вывод одномерного массива');
    writeln('3 - обработка одномерного массива (задача 1) с выдачей результатов');
    writeln('4 - обработка одномерного массива (задача 2) с выдачей результатов');
    writeln('5 - выход из программы (с подтверждением)');
    Writeln('_________________________ ');
    repeat
      Write('Выш выбор: ');
      readln(ct);
    until ct in ['1'..'5'];

    case ct of
      '1' : InitArr (a, n);
      '2' : PrintArr (a, n);
      '3' : PosMaxOrZero (a, n);
      '4' : PosingMaxSum (a, n);
      '5' : {запрос подтверждения}
            begin
              WriteLn;
              Write('Вы действительно хотите выйти из программы? (Y/N) : ');
              ReadLn(ct);
              if (ct='Y') or (ct='y') then ct := '5';
                                  { возвращаем '5'-ку в переменную, по ней будет выход из цикла }
            end;      
    end;

  until ct = '5'; { выход из программы }

  WriteLn('Программа закончила работу. Bye!');
  ReadLn
end.

Ток почему-то, 3 процедурка молчит, выводит 'Вы выбрали ..' и тишина...

Xardas · 23.11.2012, 08:40

Цитата:

Ток почему-то, 3 процедурка молчит, выводит 'Вы выбрали ..' и тишина...

Подкорректировать надо условия вывода (исправляю свой недочет)

Код:


if (nn <> -1) and (nn < nmax) then
        writeln('Ближе к началу стоит нулевой элемент');

if (nn > nmax) or (nn = -1) then
        writeln('Ближе к началу стоит максимальный элемент');

if nn = nmax then
        writeln('Первый нулевой и максимальный элементы стоят на одной позиции');

UPD: Katerina*** , оформляйте, пожалуйста, код с тегом [CODE] (знак # на панели, когда пишите сообщение), очень неудобно читать. Как минимум у Вас в программе один лишний символ '}' имеется, из-за которого программа не запустится, и end с точкой в case

22.11.2012, 01:26	#1
Katerina*** Регистрация: 22.11.2012 Сообщений: 5	Составить программу. Массивы Ребятки программисты, помогите пожалуйста с информатикой! Мне задали делать эти задачки, а информатики у меня в школе не было. Вся надежда только на вас! Вот в общем что нам задали: Составить на языке Паскаль программу, управляющуюся с помощью меню. В меню обязательно должны войти пункты: 1) ввод одномерного массива; 2) вывод одномерного массива ; 3) обработка одномерного массива (задача 1) с выдачей результатов; 4) обработка одномерного массива (задача 2) с выдачей результатов; 5) выход из программы (с подтверждением). 1.Определить, какой элемент – максимальный или первый нулевой (по порядку расположения в массиве) – стоит ближе к началу массива; 2. Определить, что больше – сумма элементов, стоящих до максимального элемента, или сумма элементов, стоящих после максимального элемента; И еще, главное чтобы вывод значений был не рандомным! Это обязательное условие. (Как-то так нам сказал преподаватель) Буду очень благодарна :* Последний раз редактировалось Katerina*; 22.11.2012 в 01:50.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Составить программу ввода значений и вычисления длины вектора(массивы)	volkodaf	Паскаль, Turbo Pascal, PascalABC.NET	1	16.11.2012 06:32
составить программу использую циклы но не используя массивы	Naruto_026	Помощь студентам	0	01.11.2011 19:18
Составить программу	ITS	Помощь студентам	2	21.10.2010 23:29
Составить программу.	kot i @	Паскаль, Turbo Pascal, PascalABC.NET	0	25.05.2010 15:39

23.11.2012, 02:27	#5
Katerina*** Регистрация: 22.11.2012 Сообщений: 5	Xardas Вы очень хороший человек, спасибо вам огромнейшее! Так меня выручили.

23.11.2012, 02:32	#6
Xardas Сисадмин Форумчанин Регистрация: 28.12.2007 Сообщений: 320	Katerina***, не за что и спасибо на добром слове Лучше потестируйте хорошо, потому что писалось на лету... мало ли...

23.11.2012, 02:59	#7
Katerina*** Регистрация: 22.11.2012 Сообщений: 5	Сейчас, занимаюсь. Если что не так, я здесь отпишусь обязательно =_