freepascal.ru

Используя очередь решить следующую задачу.
Type fr = file of real;
За один просмотр файла f типа fr и без использования дополнительных файлов напечатать элементы файла f в следующем порядке. Сначала все числа, меньше а, затем - все числа из отрезка [a, b] и, наконец, – все остальные числа, сохраняя исходный взаимный порядок в каждой из этих групп чисел (a, b – заданны a<b).

Код: Выделить всё

rogram Ochered;
uses  crt;
const  n = 50; a = 20; b =40;
type  FR = file of real;
      mass = array [1..n] of real;
var f : FR;
    before_a, a_b, after_b : mass;
    y : real;
    k, l, m, o, p, r : integer ;
   
procedure realgenerator;
   var f : file of real;
      y : real;
      i : integer ;
begin
   randomize;
   assign (f, 'd:\digit.dat');
   rewrite(f);
   for i:=1 to n do
      begin
      y:=random(50);
      write(f,y);
      end;
close(f);
end;

begin
clrscr;
realgenerator;
assign (f, 'd:\digit.dat');
reset(f);
k:=1;l:=1;m:=1; o:=1; p:=1;r:=1;

   while not Eof(f) do
      begin
         read(f, y);
 
         if y < a then
         begin   
         before_a[k] := y;
         k := k + k;
         end;
   
         if ((y >=a) and (y<=b)) then
         begin
         a_b[l] := y;
         l:=l+1;
         end;
   
         if y > b then
         begin 
         after_b[m] :=y;
         m:=m+1;
         end;   
         close(f);
      end;

   while (r<=k) do
      begin
      y := before_a[r];
      r := r + 1;
      writeln('before_a[0..',a,']: ');
      write(before_a[r]:2:0,'  ');
      writeln;
      end;

   while (o<=l) do
      begin
      y := a_b[o];
      o := o + 1;
      writeln('a_b[',a,'..',b,']: ');
      write(a_b[o]:2:0,'  ');
      writeln;
      end;

   while (p<=m) do
      begin
      y := after_b[p];
      p := p + 1;
      writeln('after_b[',b,'..',n,']: ');
      write (after_b[p]:2:0,'  ');
      readln
      end;
end.


При компилляции выдаёт ошибку. Пожалуйста подскажите, что не так.

При компилляции выдаёт ошибку. Пожалуйста подскажите, что не так.

Какую ошибку-то выдаёт компилятор?

1. Необходимо использовать Тэг [сode] для исходников, Да мне тоже не нравится зеленый цвет, и не очень удобно читать. Но администрация сайта обещала сделать подсветку синтаксиса. И при необходимости можно будет ту или иную ветку форума, сгенерировать в другой форма. (При условии, что он будет оформлен по правилам) А у вас Код не записан в Тег [Сode].
2. Nik +1.
3. Ravil -1. Какая ошибка, на какой строке. Вы думаете кому то нужно читать ваш КОД ?.
4. Где пишете в FPC или в Lazarus-е. Какая OC.
5. И конечно спасибо, за то что вы думаете, что тут одни Ясновидцы (Просьба больше не смотреть Битву Экстросенцев на ТНТ).
6. Скорее всего если нет ошибок в коде, то возможно вы не учли следущего, при заполнении массивов тогоже a_b мы его заполняем не весь... т.е в остатке лежит мусор, я сделал процедуру коррекции см код во избежании ошибки - SIGFPE — сигнал, посылаемый процессу, при попытке выполнения ошибочной арифметической операции.
Теперь по делу из-за того, что не понятно где ошибка и какая. Решил задачу на Lazarus-е.
Вот Код:

Код: Выделить всё

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;


const
n = 50; a = 20; b =40;
type
mass = array [1..n] of real;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    Procedure ShowResultFromMass(var AMass:mass);
    Procedure CorrectMass(var AMass:mass; MaxIndex:Integer);
  private
    { private declarations }
  public

    { public declarations }
  end;



var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure realgenerator;
var
    f : file of real;
    y : real;
    i : integer;
begin
  randomize;
  AssignFile(f, 'c:\digit.dat');
  Rewrite(f);

  for i:=1 to n do
    begin
      y:=random(50);
      Write(f,y);
    end;
  CloseFile(f);
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
    f : file of real;
    y : real;
    i : integer;
    IndexBefore_A, IndexA_B,
    IndexAfter_B, IndexFull :Integer;
    before_a, a_b, after_b, Full : mass;
begin
  IndexBefore_A:=1;
  IndexA_B     :=1;
  IndexAfter_B :=1;
  IndexFull    :=1;

  realgenerator; //Генерируем новый файл с данными.

  AssignFile(f,'c:\digit.dat');
  Reset(f);

  while not Eof(f) do
  begin
    Read(f, y);

    Full[IndexFull]:=y;
    Inc(IndexFull);

    if y<a then
     begin
     before_a[IndexBefore_A]:=y;
     Inc(IndexBefore_A);
     end;

    if ((y >=a) and (y<=b)) then
     begin
     a_b[IndexA_B]:=y;
     Inc(IndexA_B);
     end;

    if y>b then
     begin
     after_b[IndexAfter_B]:=y;
     Inc(IndexAfter_B);
     end;

  end;//  while not Eof(f) do
CloseFile(F);

//коррекция массивов (т.к. Мы не полностью заполнили массивы, где то есть мусор)
CorrectMass(before_a,IndexBefore_A);
CorrectMass(a_b,IndexA_B);
CorrectMass(after_b,IndexAfter_B);

//Вывод на экран результатов
  Memo1.Lines.Add('Исходный массив:');
  ShowResultFromMass(Full);

  Memo1.Lines.Add('Массив Before_A:');
  ShowResultFromMass(before_a);

  Memo1.Lines.Add('Массив a_b:');
  ShowResultFromMass(a_b);

  Memo1.Lines.Add('Массив after_b:');
  ShowResultFromMass(after_b);
end;

procedure TForm1.ShowResultFromMass(var AMass: mass);
var I:Integer;
    S:String;
begin
   S:='';
  //If AMass[1]=Nil then exit;

  for i:=1 to High(AMass) do
    if AMass[I]<> -1 then
    S:=S+FloatToStr(AMass[I])+'; ';

    Memo1.Lines.Add(S);

end;

procedure TForm1.CorrectMass(var AMass: mass; MaxIndex: Integer);
var I:Integer;
begin
    for I:=MaxIndex to High(AMass) do
    AMass[I]:=-1;
end;
end.


Вот Скрин:

В Аттаче исходники:

Как минимум ошибка в закрытии файла на каждом шаге цикла while

WinXP, fpc - 2.4.2, прога нужна для TP 7. Компилируется нормально, во время запуска - Runtime error 103 - file not open. Пишу в Geany, удобный редактор.

Добавлено спустя 7 минут 34 секунды:
В этих циклах чтение идёт из массивов (во всяком случае так было задумано)