Pascal. Решение задач

[Jaratar]

Дорогие участники! В этой теме вы можете попросить помощи в решении задач и в написании программ на языке программирования Pascal.

Кстати говоря, если вы уже частично решили задачу, или у вас есть какой-то свой вариант, при котором, правда, происходит ошибка, то будет очень хорошо, если вы приведёте здесь свой текст программы. Возможно, что тогда будет достаточно всего лишь найти и устранить какой-то изъян, и это займёт намного меньше времени.

А если вам не надо решать задачи, но вы хотите задать вопрос по языку, компиляторам, справочным руководствам - вы можете сделать это в теме Pascal.

 

[Sherry]

Еще такой вопрос.
Даны два упорядоченных массива целых чисел М1 и М2. Слить их в один упорядоченный массив. Рассмотреть случаи, когда массивы М1 и М2 упорядочены одинаково и когда по-разному.
Заранее благодарна.

 

[Xermit]

Sherry, вот тебе мой вариант задачи, не исключено, что не самый рациональный, как в прошлый раз, но работает.=)

Program XYZ;

Var
   m1, m2, a: array [1..100] of integer;
   i, j, k, h, q, n1, n2: integer;

Begin
   Read(n1);
   For i:=1 to n1 do Read(m1[i]);
   Writeln;
   Read(n2);
   for i:=1 to n2 do Read(m2[i]);
   Writeln;
   if m1[1]>m1[n1] then
    for i:=1 to (n1 div 2) do
     begin
      q:=m1[i];
      m1[i]:=m1[n1+1-i];
      m1[n1+1-i]:=q;
     end;
   if m2[1]>m2[n2] then
    for i:=1 to (n2 div 2) do
     begin
      q:=m2[i];
      m2[i]:=m2[n2+1-i];
      m2[n2+1-i]:=q;
     end;

    j:=1;
    k:=1;
    h:=1;
    while (j<=n1) and (k<=n2) do
     begin
      if m1[j]<m2[k] then
       begin
        a[h]:=m1[j];
        j:=j+1;
       end else
       begin
        a[h]:=m2[k];
        k:=k+1;
       end;
      h:=h+1;
      if j>n1 then q:=1;
      if k>n2 then q:=2;
     end;
 
    if q=1 then
     for i:=k to n2 do
      begin
       a[h]:=m2[i];
       h:=h+1;
      end;
    if q=2 then
     for i:=j to n1 do
      begin
       a[h]:=m1[i];
       h:=h+1;
      end;
   for i:=1 to h-1 do Write(a[i],' ');
  End.

 

[kipelovets]

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

program Project2;
var
  i,j,k,n,m,di,dj: Integer;
  a,b,c: array[0..999] of Integer;
  x,y: boolean;
begin
  // Ввод...
  Read(n);
  for i:=0 to n-1 do
    Read(a[i]);
  Read(m);
  for i:=0 to m-1 do
    Read(b[i]);

  // В зависимости от направления упорядоченности массивов _
  // устанавливаем начальные значения счетчиков и приращения
  if (n>1) and (a[1]>a[0]) then
  begin
    i:=0;
    di:=1;
  end
  else
  begin
    i:=n-1;
    di:=-1;
  end;

  if (m>1) and (b[1]>b[0]) then
  begin
    j:=0;
    dj:=1;
  end
  else
  begin
    j:=m-1;
    dj:=-1;
  end;

  // ну а теперь большой цикл, в котором все и происходит...
  k:=0; // счетчик для нового массива
  x:=true; // флаг, что у нас массивы не кончились
  while x do
  begin
    y:=true; // По умолчанию копируем из массива "а"
    if (i>=0) and (i<n) then
    begin
      if (j>=0) and (j<m) then
      begin
        if a[i]>b[j] then
          y:=false; // Если не кончились оба массива и a[i]>b[j], то копируем из массива "b"
      end
    end
    else
    begin
      if (j>=0) and (j<m) then
        y:=false
      else
        x:=false; // Если оба массива кончились - завершаем цикл
    end;
    if x then
    begin
      if y then
      begin
        c[k]:=a[i];
        i:=i+di;
      end
      else
      begin
        c[k]:=b[j];
        j:=j+dj;
      end;
    end;
    Inc(k);
  end;

  // Вывод...
  for i:=0 to m+n-1 do
    Write(c[i],' ');
end.

я уже не уверен, что это работает, я писал в дельфи и с файловых IO, потом переписывал...

 

[Xermit]

Sherry, я уж испугался.))
Проверил, она работает, может ты что-нибудь не то вводишь?
Сначала ты должна ввести количество элементов массива M1, потом все его элементы, затем количество элементов массива M2, и после тоже все его элементы. Попробуй еще раз. Да и вариант kipelovets тоже работает, только комментарии исправь (или удали).

И еще, если массивы упорядочены по-разному, или по убыванию, то программа все равно выведет по возрастанию.

 

[Sherry]

Можно пример?

 

[Xermit]

Входные данные:
1 1
2 3 2
Выходные данные:
1 2 3

 

[Шогал]

Млин, это же обыкновенная подзадача MergeSort'а...

Самый простой способ слить массивы a и b в c. Параметры n1 и n2 - размеры массивов a и b. Массивы нумеруются с нуля (но легко переделать чтобы нумеровались с единицы).

procedure mergearr(var a, b, c : your_array_type; n1, n2 : integer);
var i, i1, i2 : integer;
begin
  i := 0; {текущий элемент общего массива}
  i1 := 0; {текущий элемент первого массива}
  i2 := 0; {текущий элемент втрого массива}
  while((i1 < n1) and (i2 < n2)) do begin {итерируем пока один из массивов не кончится}
    if(a[i1] < b[i2]) then begin {если в a элемент меньше чем в b}
      c[i] := a[i1];
      inc(i1);
    end else begin
      c[i] := b[i2];
      inc(i2);
    end;
    inc(i);
  end;
  if i1 = n1 then {если кончился первый массив}
    move(b[i2], c[i], (n2-i2)*sizeof(your_array_element)) {перемещаем остаток второго массива в c}
  else
    move(a[i1], c[i], (n1-i1)*sizeof(your_array_element));
end;

По-моему, еще проще чем этот алгоритм написать уже невозможно...

А когда какой-нибудь массив упорядочен по-убыванию - просто инвертируй его перед вызовом процедуры

 

[Tashik]

Чет здесь давно никто не бывал, Ну может мне все таки кто то поможет!( до завтра) Нужно составить программу вычесляющая сумму нечетных чисел. Я сделала эту программу через оператор с предпроверкой. Но нужно еще и через счетный. Помогите.

 

[Trotil]

1) Покажи свое решение

 

[Tashik]

Сейчас уже точно не вспомню но помоему вот так
program probA;
var i,n,s:integer;
begin;
writeln('программа вычесл.......');
writeln('задайте n');
readln;
s:=0; i:=1;
while i<=n do
begin;
s:=s+1;
i:=i+2;
end;
end.

 

[Trotil]

n - число нечетных чисел
s:=0;
for i:=1 to n do s:=s+(2*i+1);

 

[Velgelmina]

Работа с файлами в Pascal

Прошу помощи и совета.
Не могу правильно написать программу.
условие задачи:
1.создать файл содержащий сведенья о сдачи студентами сессии. структура записи: индекс группы,фамилия студента,оценки по 3 экзаменам.
2.определить неуспевающих студентов. средний балл группы.

первую программу он выполняет, но во второй пишет ошибку fail not opened
не могу понять почему он не открывает файл.
если можете то напишите свой вариант программы или укажите на возможные ошибки.
понимаю, что нагло, но первый вариант был бы предпочтительней.

 

[Trotil]

Velgelmina
А код неправильный привести? Просто у меня среды исполнения нет, а по коду смогу что-нибудь подправить или подсказать..

Код оформлять тегом

 

[Velgelmina]

если вдруг неправильно оформлю, заранее извините:

Program fail; uses crt;
type student=record
index:string;
fam:string;
ysp:array[1..3] of integer;
end;
var f:file of student;
a:student;
i:byte;
j:byte;
begin
clrscr;
assign (f,'d:\student.txt');
rewrite (f);
for i:=1 to 3 do begin
writeln ('vvedite familiy');
readln (a.fam);
writeln ('vvedite gruppy');
readln (a.index);
writeln ('vvedite ocenki po trem ekzamenam:');
for j:=1 to 3 do begin
readln (a.ysp[j]);
write (f,a);
end;
end;
close(f);
end.

это текст первой программы. ее он выполняет.
сейчас напишу вторую.

вот вторая часть:

Program fail2; uses crt;
type student=record
fam:string;
index:string;
ysp:array [1..3] of integer;
end;
var f:file of student;
a:student;sr:real;
S:integer;
i:byte;
m:integer;
begin
clrscr;
assign(f,'d:\student.txt');
reset(f);
while not eof(f) do begin read (f,a);
if a.ysp[i]=3 then write (a.fam);
m:=m+1;
S:=S+i;
sr:=S/m;
writeln ('srednii ball=',sr);
close (f);
end
end.

выдает ошибку на while.

 

[Erenion]

Очень давно юзал паскаль, уже мало помню структуру, но все же:

close (f); перед закрытием цикла. Естестна, ты открываешь файл, цикл проходит одну итерацию и он закрывается в конце. А на следующей итерации файл не открыт))

Поставь close (f); после цикла, а не внутри..

 

[Velgelmina]

а Вы не могли исправить в этой теме? в смысле неправильный текст программы исправить на правильный?
просто я исправила сейчас в Pascale он все равно выдает file not opened.

 

[GamerDenis]

Ох.
У вас много ошибок.

Вот правильные сорцы.
Первая программа:

Program fail;
uses crt;
type student=record
index:string;
fam:string;
ysp:array[1..3] of integer;
end;
var f:file of student;
a:student;
i:byte;
j:byte;
begin
clrscr;
assign (f,'d:\student.txt');
rewrite (f);
for i:=1 to 3 do begin
writeln ('vvedite familiy');
readln (a.fam);
writeln ('vvedite gruppy');
readln (a.index);
writeln ('vvedite ocenki po trem ekzamenam:');
for j:=1 to 3 do
   readln (a.ysp[j]);

write (f,a);
end;
close(f);
end.

Вторая программа:

Program fail2;
uses crt;
type student=record
index:string;
fam:string;
ysp:array [1..3] of integer;
end;
var f:file of student;
a:student;sr:real;
S:integer;
m:integer;
begin
clrscr;

assign(f,'d:\student.txt');
reset(f);

writeln('familii neuspevayushih:');

m:=0;
S:=0;
while not eof(f) do begin read (f,a);
if (a.ysp[1] <= 3) or (a.ysp[2] <= 3) or (a.ysp[3] <= 3) then writeln (a.fam);
m:=m+3;
S:=S + a.ysp[1] + a.ysp[2] + a.ysp[3];
sr:=S/m;
end;
writeln;
writeln ('srednii ball=',sr:3:1);
close(f);
readln;
end.

Давайте по порядку?

Первое. Типы данных должны быть одинаковые в обоих программах. А у вас -- разные.

type student=record
index:string;
fam:string;
ysp:array[1..3] of integer;
end;

type student=record
fam:string;
index:string;
ysp:array [1..3] of integer;
end;

Чуете разницу? Нельзя переставлять местами переменные. Порядок -- важен. Ибо то, что у вас в первой программе было фамилией, во второй программе стало названием группы. Ну и название группы стало фамилией.


Далее.
Ошибка на цикл вылетала потому, что вы закрывали файл в цикле. А надо после окончания ВСЕЙ работы.

Еще одна важная вещь -- у вас неправильно написана первая программа

for j:=1 to 3 do begin
readln (a.ysp[j]);
write (f,a);
end;

Этот вот кусок считывает оценки.
Но! Зачем! Он! Пишет в файл ВСЮ "запись" о студенте? У вас получается три записи!
Запись "записи"(record) в файл надо производить в КОНЦЕ каждого цикла!



Вернемся ко второй программе.
Переменные нужно обнулять.
У вас в цикле идет накопление суммы:

m:=m+3;
S:=S + a.ysp[1] + a.ysp[2] + a.ysp[3];

Перед циклом необходимо обнулить переменные:

m:=0;
S:=0;

Зачем? А затем, что в m и S могут изначально находиться страшные цифры, отличные от нуля. Естественно, это приведет к ошибке.


Далее.

if a.ysp[i]=3 then write (a.fam);

Что вы хотели сказать этой строчкой? i у вас даже не определена.
Вы считали ПОЛНОСТЬЮ запись.
Вам надо проверить, не является ли ХОТЯ БЫ одна из трех оценок меньше или равной трем.
Это делается так:

if (a.ysp[1] <= 3) or (a.ysp[2] <= 3) or (a.ysp[3] <= 3)

Далее.

m:=m+1;
S:=S+i;

Что вы хотели этим сказать? У вас же по каждому студенту три оценки! Надо их все в общую сумму складывать. И считать их как три

Т.е.:

m:=m+3;
S:=S + a.ysp[1] + a.ysp[2] + a.ysp[3];

Ну и опять же.
ВЫВОД результатов надо делать ПОСЛЕ цикла. А не в его теле. Посмотрите, где стоит end; для цикла у меня и у вас.

И на последок.

writeln ('srednii ball=',sr:3:1);

Эта волшебная конструкция 3:1) означает, что под число с плавающей запятой будет выделено три клеточки. Из них одна клеточка -- под десятичную часть.


Удачи!

 

[Velgelmina]

Спасибо огромное! и отдельное, за указанные ошибки!
если Вам не трудно, то не могли бы написать код решения еще двух задач.
1.Динамические структуры данных:
-Описание процедуры или функции, которая удаляет из списка L за каждым вхождением элемента E один элемент, если такой есть и он отличен от E.
2.Модуль:
-нахождение максимального элемента матрицы
-нахождение минимального элемента матрицы
-сложение двух матриц
-нахождение суммы элементов каждой строки данной матрицы.
и по этому модулю решить задачу:
-сложить две матрицы
-напечатать в общем виде
-найти максимальный и минимальный элемент, а также вычислить сумму элементов каждой строки.

заранее Вам благодарна.
(я понимаю, что это большая просьба, но вы мне ОЧЕНЬ поможете, если ответите)

 

[GamerDenis]

Все же попробуйте написать сами.
И назовите крайние сроки

Сейчас совсем нету времени...