Технический форум

Технический форум (http://www.tehnari.ru/)
-   Помощь студентам (http://www.tehnari.ru/f41/)
-   -   Паскаль. Задача о расписании поездов (http://www.tehnari.ru/f41/t77081/)

virginia 11.08.2012 12:57

Паскаль. Задача о расписании поездов
 
{Создать массив(расписание движения),хранящий информацию о 20 поездах,отправляющихся со станции Воронеж.
Каждый элемент расписания содержит информацию:номер поезда,пункт назначения,время отправления,количество свободных мест
в вагонах типа св,купе,плацкарт.а)упорядочить массив по пункту назначения.Вывести информацию о поездах,отходящих в заданный период
времени и следующих до заданного пункта назначения в типизированный файл}.помогите сделать вывод в типизированный файл
Код:

program Project2;

{$APPTYPE CONSOLE}
uses
  SysUtils,
  Windows;
const
    n=20;
type
    traininfo=record
    numbertrain:integer;
    destination:string;
    timeofdeparture_h:integer;
    timeofdeparture_m:integer;
    sv:Integer;
    compartment:integer;
    plackart:integer;
    end;
tmas=array [1..n] of traininfo;
var
  train:tmas;
  i,t_h,t_m:Integer;
  time1,time2:real;
  destination,s:string;
  f,f1:Text;
//-----------------------------------------------------------------
procedure vvoddannuh;
var
 i,numbertrain,timeofdeparture_h,timeofdeparture_m,
 sv,compartment,plackart:Integer;
 destination:String;
 f:Text;
begin
  Assign(f,'train_1.txt');
  Rewrite(f);
  writeln (f,'------------------------------------------------------------');
  writeln (f,'номер / пункт назначения / время отпр. / св / купе / плацк. ');
  writeln (f,'------------------------------------------------------------');
  for i:=1 to n do
  begin
    Write('введи номер поезда: ');
    Readln(numbertrain);
    Write('введи пункт назначения: ');
    Readln(destination);
    Write('введи время отправления (чч мм): ');
    Readln(timeofdeparture_h,timeofdeparture_m);
    Write('введи количество свободных мест в св: ');
    Readln(sv);
    Write('введи количество свободных мест в купе: ');
    Readln(compartment);
    Write('введи количество свободных мест в плацкарте: ');
    Readln(plackart);
    writeln(f,numbertrain:5,destination:19,timeofdeparture_h:8,timeofdeparture_m:3,sv:8,compartment:7,plackart:8);
    writeln
  end;
 Close(f)
end;
//-----------------------------------------------------------------
Procedure vuvoddannuh(a:tmas);
var
 i:Integer;
 f:Text;
begin
  Assign(f,'train_2.txt');
  Rewrite(f);
  writeln (f,'------------------------------------------------------------');
  writeln (f,'номер / пункт назначения / время отпр. / св / купе / плацк. ');
  writeln (f,'------------------------------------------------------------');
  for i:=1 to n do
  writeln(f,a[i].numbertrain:5,a[i].destination:19,a[i].timeofdeparture_h:8,a[i].timeofdeparture_m:3,a[i].sv:8,a[i].compartment:7,a[i].plackart:8);
  Close(f)
end;
//------------------------------------------------------------------------------------------
Procedure Read_data(Var a: tmas);
Var
 i,j:Integer;
 f:Text;
 C:Char;
 begin
  Assign(f,'train_1.txt');
  Reset(f);
  readln(f);
  readln(f);
  readln(f);
  for i:=1 to n do
    begin
      read(f,a[i].numbertrain);
      repeat
        read(f,C);
      until C<>' ';
      a[i].destination:=C;
      repeat
        read(f,C);
        if C<>' ' then  a[i].destination:=a[i].destination+C;
      until C=' ';
      readln(f,a[i].timeofdeparture_h,a[i].timeofdeparture_m,a[i].sv,a[i].compartment,a[i].plackart);
    end;
  Close(f)
 end;
//------------------------------------------------------------------------------------------
Procedure Swap(Var k, l: traininfo);
Var m:traininfo;
 begin
  m := k;
  k := l;
  l := m;
 end;
// --------------------------------------------------------------------------
Procedure sortirovka;
var
 x:traininfo;
 i,j:Integer;
begin
 for i:=1 to n-1 do
  for j:=1 to n-i do
  if train[j].destination>train[j+1].destination then
  Swap(train[j],train[j+1]);
end;
//--------------------------------------------------------------------------------
Procedure search_train(a:tmas;destination:string;tm1,tm2:real);
var
 i,S:Integer;
 f:Text;
begin
  Assign(f,'train_2.txt');
  Append(f);
  Writeln(f);
  S:=0;
  for i:=1 to n do
  if (a[i].destination=destination) and
    (a[i].timeofdeparture_h+a[i].timeofdeparture_m/100>=tm1) and
    (a[i].timeofdeparture_h+a[i].timeofdeparture_m/100<=tm2) then
      begin
        Writeln(f,'номер поезда: ',a[i].numbertrain);
        Writeln(f,'пункт назначения: ',a[i].destination);
        Writeln(f,'время отправления: ',a[i].timeofdeparture_h,'-',a[i].timeofdeparture_m);
        Writeln(f,'количество мест в св: ',a[i].sv) ;
        Writeln(f,'количество мест в купе: ',a[i].compartment);
        Writeln(f,'количество мест в плацкарте: ',a[i].plackart);
        Writeln(f);
        S:=S+1
      end;
  if S=0 then writeln(f,'таких поездов нет');
  Close(f);
end;

begin
  SetConsoleOutputCP(1251);
  if FileExists('train_1.txt')then
  begin
  read_data(train);
  assign(f,'train_1.txt');
  reset(f);
  while not eof(f) do
  begin
  readln(f,s);
  writeln(s);
  end;
  close(f);
  sortirovka;
  vuvoddannuh(train);
  Writeln('введи пункт назначения:');
  Readln(destination);
  writeln('введи период времени(формат ввода чч мм) с');
  readln(t_h,t_m);
  time1:=t_h+t_m/100;
  writeln('по');
  Readln(t_h,t_m);
  time2:=t_h+t_m/100;
  search_train(train,destination,time1,time2);
  assign(f1,'train_2.txt');
  reset(f1);
  while not eof(f1) do
  begin
  readln(f1,s);
  writeln(s)
  end;
  close(f1)
  end
  else vvoddannuh;

 Writeln('Для выхода нажмите enter');
 readln
end.


Vladimir_S 11.08.2012 19:23

Цитата:

Сообщение от virginia (Сообщение 778236)
Вывести информацию о поездах,отходящих в заданный период времени и следующих до заданного пункта назначения в типизированный файл.

То есть вместо текстового следует использовать файл записей? А первый (train_1) - тоже? Ладно, допустим, что так. Сделаю завтра утром.

Vladimir_S 12.08.2012 11:19

Ну вот, как-то так. Вроде довёл до ума с типизированными файлами. Добавил немного украшений типа запроса о переписывании исходного файла, буде он существует, ну и еще по мелочи. Что касается функции FileExists, то в моём Паскале таковой среди стандартных не имеется, а потому я изготовил самодельную. Если не нужна, смахните ее.
Код:

program Project2a;
                 
{$APPTYPE CONSOLE}
uses
  SysUtils,
  Windows; 
const
    n=20;
type
 traininfo=record
            numbertrain:integer;
            destination:string[30];
            timeofdeparture_h:integer;
            timeofdeparture_m:integer;
            sv:Integer;
            compartment:integer;
            plackart:integer;
          end;
 tmas=array [1..n] of traininfo;
 f_tr=file of traininfo;
var
  train:tmas;
  i,t_h,t_m,M,fd:Integer;
  time1,time2:real;
  destination,s:string;
  fx:f_tr;
//-----------------------------------------------------------------
function FileExists(Name:String):Boolean;
Var
 ffe:f_tr;
 IOres:Integer;
begin
 {$I-}
 Assign(ffe,Name);
 Reset(ffe);
 IOres:=IOResult;
 If IOres=0 then Close(ffe);
 FileExists:=IOres=0;
 {$I+}
end;
//-----------------------------------------------------------------
procedure vvoddannuh;
var
 i:Integer;
 destination:String;
 f:f_tr;
begin
  Assign(f,'train_1');
  Rewrite(f);
  for i:=1 to n do
  begin
    Write('Введите номер поезда: ');
    Readln(train[i].numbertrain);
    Write('Введите пункт назначения: ');
    Readln(train[i].destination);
    Write('Введите время отправления (чч мм): ');
    Readln(train[i].timeofdeparture_h,train[i].timeofdeparture_m);
    Write('Введите количество свободных мест в СВ: ');
    Readln(train[i].sv);
    Write('Введите количество свободных мест в купе: ');
    Readln(train[i].compartment);
    Write('Введите количество свободных мест в плацкарте: ');
    Readln(train[i].plackart);
    write(f,train[i]);
  end;
  Close(f)
end;
//-----------------------------------------------------------------
Procedure Show_data(a:tmas;Nshd:Integer);
var
 i:Integer;
begin
 If Nshd=0 then
  writeln('Таких поездов нет!')
 else
  begin
  writeln ('------------------------------------------------------------');
  writeln ('номер / пункт назначения / время отпр. / св / купе / плацк. ');
  writeln ('------------------------------------------------------------');
  for i:=1 to Nshd do
    writeln(a[i].numbertrain:5,a[i].destination:19,a[i].timeofdeparture_h:8,a[i].timeofdeparture_m:3,a[i].sv:8,a[i].compartment:7,a[i].plackart:8);
  end
end;
//-----------------------------------------------------------------
Procedure vuvoddannuh(F_Name:String;a:tmas;Nvuv:Integer);
var
 i:Integer;
 f:f_tr;
begin
 Assign(f,F_Name);
 Rewrite(f);
 for i:=1 to Nvuv do
  write(f,a[i]);
 Close(f)
end;
//------------------------------------------------------------------------------------------
Procedure Read_data(F_Name:String; Nrd:Integer; Var a: tmas);
Var
 i:Integer;
 f:f_tr;
 begin
  Assign(f,F_Name);
  Reset(f);
  for i:=1 to Nrd do
    read(f,a[i]);
  Close(f)
 end;
//------------------------------------------------------------------------------------------
Procedure Swap(Var k, l: traininfo);
Var m:traininfo;
 begin
  m:=k;
  k:=l;
  l:=m;
 end;
// --------------------------------------------------------------------------
Procedure sortirovka(a1:tmas;var a2:tmas);
var
 b:tmas;
 x:traininfo;
 i,j:Integer;
begin
 b:=a1;
 for i:=1 to n-1 do
  for j:=1 to n-i do
  if b[j].destination>b[j+1].destination then
  Swap(b[j],b[j+1]);
 a2:=b;
end;
//--------------------------------------------------------------------------------
Procedure search_train(a:tmas;destination:string;tm1,tm2:real;var Nst:Integer);
var
 i,S:Integer;
 f:f_tr;
begin
 S:=0;
 Assign(f,'train_3');
 Rewrite(f);
 for i:=1 to n do
  if (a[i].destination=destination) and
    (a[i].timeofdeparture_h+a[i].timeofdeparture_m/100>=tm1) and
    (a[i].timeofdeparture_h+a[i].timeofdeparture_m/100<=tm2) then
  begin
    Inc(S);
    Write(f,a[i]);
  end;
 Close(f);
 Nst:=S;
end;

begin                     
 SetConsoleOutputCP(1251);   
 if FileExists('train_1') then
  begin
  Writeln('Файл данных существует. Что с ним делать?');
  Writeln('  1 - удалить и ввести данные заново');
  Writeln('  2 - работать с существующими данными');
  Readln(fd);
  if fd=2 then
    begin
    Read_Data('train_1',n,train);
    Writeln('Исходное расписание:');
    Show_Data(train,n);
    Writeln('Нажмите "Enter" для продолжения...');
    Readln;
    sortirovka(train,train);
    vuvoddannuh('train_2',train,n);
    Read_Data('train_2',n,train);
    Writeln('Упорядоченное расписание:');
    Show_Data(train,n);
    Writeln('Нажмите "Enter" для продолжения...');
    Readln;
    Writeln('Введите пункт назначения:');
    Readln(destination);
    writeln('Введите период времени (формат ввода чч мм):');
    write('с  ');
    readln(t_h,t_m);
    time1:=t_h+t_m/100;
    write('по ');
    Readln(t_h,t_m);
    time2:=t_h+t_m/100;
    search_train(train,destination,time1,time2,M);
    Read_Data('train_3',M,train);
    Show_Data(train,M);
  end
  else
    begin
    Assign(fx,'train_1');
    Erase(fx);
    vvoddannuh;
    end;
  end
  else vvoddannuh;
 Writeln('Для выхода нажмите "Enter"');
 readln
end.


virginia 12.08.2012 13:51

задача не запускается

Vladimir_S 12.08.2012 15:03

Цитата:

Сообщение от virginia (Сообщение 778706)
задача не запускается

Ну вот те здрасьте!
Несколько часов отлаживал, гонял в хвост и в гриву и пожалуйста!
На всякий случай, перечень отличий. Поскольку у меня DOS Free Pascal, то:
1. Были закомментарены указание транслятору {$APPTYPE CONSOLE} и радел Uses - у меня таких модулей нет, да и не нужны.
2. В начале тела программы была закомментарена строка
SetConsoleOutputCP(1251);
По той же причине.
3. В путях к файлам был прописан диск D, т.е, например, не
Assign(f,'train_2');
а
Assign(f,'D:\train_2');
Вроде и всё.

А подробнее можно? На что именно ругается, что сообщает и т.п.

virginia 12.08.2012 15:08

type traininfo needs finalization-not allowed in file type

Vladimir_S 12.08.2012 15:20

Цитата:

Сообщение от virginia (Сообщение 778733)
type traininfo needs finalization-not allowed in file type

А, ну это уже задвиги транслятора. Если он такой убогий, что не переваривает файлов записей, то даже и не знаю, чем помочь. Сейчас пошарю по Сети, посмотрю, может кто что подскажет, как быть в такой ситуации.

Vladimir_S 12.08.2012 15:28

Ага - ну понял! Вернее, вычитал.
Всё дело во втором поле записи - destination. Этот Ваш Object-Pascal, как и Delphi, не переносит в записи строк необъявленной длины. Поставьте вместо
destination:string;
что-нибудь типа
destination:string[30];
и всё пойдет.
Мой-то Паскаль жрёт и не давится.

Gruvi 12.08.2012 16:36

Некоторые делфи не давятся от строк не объявленной длины, но проще конечно поставить в строке 200 символов, и все.

AlexZir 12.08.2012 20:33

Что-то мне подсказывает, что у ТС какая-нибудь версия не к добру упомянутого ПаскальАБС


Часовой пояс GMT +4, время: 17:56.

Powered by vBulletin® Version 4.5.3
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.