Файлы Турбо Паскаля

Начнём этот раздел с небольшого замечания о том, что часто бывает удобно отдельные виды обработки файлов оформлять как отдельные процедуры. В число формальных параметров таких процедур обычно включается или имя файловой переменной (обязательно передоваемой по ссылке, т.е. VAR !), или стринг, определяющий физическое имя обрабатываемого в процедуре файла.

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

В качестве примера, воспроизведём здесь вариат уже представленного на сайте решения следующей сформулированной мною на лекции задачи:

Задача "Треугольник". Написать программу, которая формирует по заданному натуральному N, текстовый файл следующей треугольной структуры :
1
2 3
4 5 6
7 8 9 10
...
Каждая следующая строка этого файла содержит на один элемет больше предыдущей, а последней считается та, в которую попадёт заданное натуральное N.

  1. Program txtFileOut;
  2.    // обошлись без переменных!
  3.     procedure triangle(n:integer; var f: Text);
  4.         Var i, inLn, lnCount: LongInt;
  5.     Begin
  6.         i:=1;  // значение первого элемента
  7.         inLn:=1; // число элементов в 1-й строке
  8.         Repeat
  9.            For lnCount:=1 to inLn Do Begin  // формируем строку
  10.               Write(f,i:3); Inc(i)
  11.            End;
  12.            WriteLn(f); // к следующей строке ...
  13.            Inc(inLn); //... в которой будет на один элемент больше
  14.         Until i>n;
  15.     End;
  16.  
  17. Begin
  18.    triangle(20, output);
  19.    readln;
  20. End.

Заметьте, для проверки решающей задачу процедуры в главной программе использован стандартный текстовый файл output. Это позволяет обойтись без его описания, привязки и открытия в главной программе. Правда, результат мы получим на экране, а не на диске. Запустите и убедитесь что всё работает!
Теперь измените главную программу с тем, чтобы файл выводился на диск. И снова проверьте!

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

Задача fl1. Дана входная последовательность натуральных чисел, завершающаяся нулём. Написать процедуру, позволяющую ввести эту последователность с клавиатуры и переписать её в выходной файл, который можно было бы далее просмотреть с помощью Блокнота. Дополнить решение вызывающей программой.

Задача fl2. В Блокноте набран и сохранён под именем 'ttt.txt' текстовый файл, содержащий по одному символу (Char) в каждой строке. Длина файла не превышает 255. Написать программу, которая читает этот файл как типизированный и формирует объединяющий все его символы стринг.

Задача fl3. В Блокноте набран и сохранён под именем 'D.txt' текстовый файл, содержащий по одному символу (Char) в каждой строке. Длина файла произвольна. Написать программу, которая читает этот файл и формирует на его основе файл 'R.txt' в котором символы исходного файла расположены в обатном порядке.

Задача fl4. Описать функцию, которая по данному текстовому файлу определяет число содержащихся в ней строк.

Задача fl5.Для задаваемых M, N <= 20 сформировать матрицу A(M,N) из случайных натуральных значений (меньших ста) и вывести её построчно (т.е. в "естественном" виде), в текстовый файл. Проверить результат вывода в Блокноте.

Задача fl6.Матрицу, сформированную в задаче fl5 ввести из файла и вывести в транспонированном виде на экран.

т.е. 13 сравниваем с 54, а

т.е. 13 сравниваем с 54, а потом и 68 сравниваем с этим числом и уходим в нужное поддерево

Вика

сравниваем с корнем а потом уходим в нужное поддерево

я поняла, спасибо:-)

я поняла, спасибо:-)

Не рекурсивный вывод

Вот не рекурсивная процедура вывода дерева бин поиска в обратном порядке

  1.  procedure NeRecObrat(root:t);
  2.      var
  3.        p:pel;
  4.    begin
  5.      if Root<>nil  then
  6.        push (root);
  7.      while not empty do begin
  8.        p:=pop;
  9.        while p^.l<>nil do begin
  10.          push (p); p:=p^.l;
  11.        end;
  12.        write(p^.inf,' ');
  13.        if (p^.r <> nil) then
  14.          push(p^.r)
  15.        else begin
  16.          while  not empty do begin
  17.            p:=pop;
  18.            write (p^.inf,' ');
  19.            if (p^.r<> nil) then begin
  20.              push (p^.r);
  21.              break;
  22.            end;
  23.          end;
  24.        end;
  25.      end;
  26.    end;

Сурен, если не сложно строки

Сурен, если не сложно строки с 7 по 10

т.е. эти строки значат

т.е. эти строки значат следующее: "взяли верхний элемент, далее, пока его левая часть не пуста, мы вытаскиваем элемент, кладем в стек и продолжаем движение по этой же левой стороне" ??

Сурен, немного остается

Сурен, немного остается непонятной логика строк с 13 по 20...если можешь, помоги направить мысли в правильную сторону

да, здесь в стек заносятся

да, здесь в стек заносятся все левые элементы выходящие из данного корня р, до того у которого нет левой ветви

Далее в зависимости от

Далее в зависимости от состояния правого поддерева элемента р, либо входим в это поддерево (если оно существует) либо поднимаемся выше по дереву и обрабатываем правые ветви уже пройденных элементов

Да, точно.теперь все ясно

Да, точно.теперь все ясно

Валерий Шахамболетович! В

Валерий Шахамболетович! В лекциях была дана задача для самостоятельного решения, построить точную копию бинарного дерева. Я попыталась реализовать рекурсивную процедуру, но попытка вышла не очень удачной. Подскажите, как правильно.

  1. procedure Copy(three:pel;var three2:pel);//three - наше дерево, three2 - копия
  2. var i:byte;
  3. begin
  4.   if three=nil then three2:=nil
  5.   else begin
  6.      new(three2);
  7.      three^.inf:=three^.inf;
  8.      Copy(three^.L,three2^.L);
  9.      Copy(three^.R,three2^.R);
  10.   end;
  11. end;

Вика

А что у тебя происходит в строке 7 ?!
может все таки так ?

  1. ...
  2. three2^.inf:=three^.inf;
  3. ...

да, Никит, так. Это я знаю,

да, Никит, так. Это я знаю, опечатка, просто поздно заметила не успела исправить

Почему же "не очень удачной"

Почему же "не очень удачной" Вика. Ваша попытка очень даже удачна (описка, замеченная Никитой не в счёт). Во всяком случае, более короткого кода я не знаю. Молодец!

А вот обратный нерекурсивный обход в исполнении Сурена мне точно не нравится. Как становится уже его "фирменным стилем" - неоправданно сложная логика (о чём свидетельствуют повторы фрагментов текста, вложенные в циклы с if-then-else - конструкциями в сочетании с break) и неудачное по структуре (к тому же, без единого комментария!) оформление.
(Впрочем, Сурен - единственный, кто эту задачу решил!)

Вот мой вариант:

  1. procedure ObrObhNR(Btr: PEL);
  2.    Var p: PEL;
  3. Begin
  4.    If Btr<> nil Then Begin   //если б.д. пусто, ничего делать не надо, иначе ...
  5.        p:=BTr; INI;  // инициализировать стек  и ...
  6.  
  7.        M: While p<>nil do Begin // загрузить в стек траекторию спуска от корня "влево-вниз"
  8.            PUSH(p); p:=p^.L;
  9.        End;
  10.        
  11.        Repeat
  12.            p:=POP;  // забрать верхний элемент стека
  13.            Write(p^.inf); //обработать его и ...
  14.            p:=p^.r;   // перейти к правому его сыну,
  15.            If p<> nil Then //при наличии которого, рассмотреть уже его как текущий корень ...
  16.                             goto M;  // и продолжить загрузку стека уже его "левыми связями"
  17.        Until  EMP; //завершить, если все элементы в стеке обработаны
  18.    End //If Btr<> nil
  19. End;

А это, для сравнения, вариант Сурена:
  1. procedure NeRecObrat(root:t);
  2.      var
  3.        p:pel;
  4.    begin
  5.      if Root<>nil  then
  6.        push (root);
  7.      while not empty do begin
  8.        p:=pop;
  9.        while p^.l<>nil do begin
  10.          push (p); p:=p^.l;
  11.        end;
  12.        write(p^.inf,' ');
  13.        if (p^.r <> nil) then
  14.          push(p^.r)
  15.        else begin
  16.          while  not empty do begin
  17.            p:=pop;
  18.            write (p^.inf,' ');
  19.            if (p^.r<> nil) then begin
  20.              push (p^.r);
  21.              break;
  22.            end;
  23.          end;
  24.        end;
  25.      end;
  26.    end;

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

ВЫВОД: Понятие стиля, культуры программирования - не пустой звук!

Если цель - неприменно избавиться от

Если цель - неприменно избавиться от GOTO, то этому соответствует, например, такая версия моего кода:

  1. Procedure StkLeftLoad(p:PEL);
  2. Begin
  3.      While p<>nil do Begin //загрузить в стек траекторию спуска  "влево-вниз"
  4.            PUSH(p); p:=p^.L;
  5.      End
  6. End;
  7.  
  8. procedure ObrObhNR(Btr: PEL);
  9.    Var p: PEL;
  10. Begin
  11.    If Btr<> nil Then Begin   //если б.д. пусто, ничего делать не надо, иначе ...
  12.        p:=BTr; INI;  // инициализировать стек  и ...
  13.        StkLeftLoad(p); //загрузить в стек траекторию спуска от корня "влево-вниз"
  14.  
  15.        Repeat
  16.            p:=POP;  // забрать верхний элемент стека
  17.            Write(p^.inf); //обработать его и ...
  18.            p:=p^.r;   // перейти к правому его сыну,
  19.            If p<> nil Then //при наличии которого, рассмотреть уже его как текущий корень ...
  20.                     StkLeftLoad(p);  // и  загрузить стек уже его "левыми связями"
  21.        Until  EMP; //завершить, если все элементы в стеке обработаны
  22.    End //If Btr<> nil
  23. End;

только у Вас маленькая

только у Вас маленькая опечаточка в названии процедуры StkLeftLoad, а вызываете LeftStkLoad

Исправил, спасибо.

Исправил, спасибо.

Здравствуйте. Почему для ABC

Здравствуйте. Почему для ABC push - не известный идентификатор?

Ксюша

push это процедура которая находится в модуле (наверное имя модуля - IntStack), наверное ты не подключила этот модуль

Морской бой

Народ, оцените мою игрульку, Морской бой :)
http://rghost.ru/45803255

Здравствуйте! Валерий

Здравствуйте! Валерий Шахамболетович, Вы не опубликуете конкретные темы по контрольной по дискретной математике?

Не публикую, т.к. всё же

Не публикую, т.к. всё же решил провести в среду семинар - совсем не решали задач по графам!

Здравствуйте, Валерий Шахамболетович вот вариант решения задачи5

  1. program fl5;
  2. var
  3.   M,N:Integer;
  4.   i,j:word
  5.   mas: array [1..20,1..20] of Integer;
  6.   F:TextFile;
  7. begin
  8.   Randomize;
  9.   Writeln ('введите M<20');
  10.   Readln (M);
  11.   Writeln ('введите N<20');
  12.   Readln (N);
  13. for i:=1 to M do
  14.   for j:=1 to N do begin
  15.   mas [i,j]:=Random (100);
  16. end;
  17. Assign (f,'C:\test\mas.txt');
  18. Rewrite (f);
  19. for i:=1 to M do begin
  20.   for j:=1 to N do begin
  21.   write (f, mas [i,j],' ');
  22.   end;
  23.   Writeln (f,' ');
  24. end;
  25. CloseFile(f);
  26. end.

Николай, мне не понятна

Николай, мне не понятна строка 22: write (' ');
Мы, получается, все время в цикле будем печать один пробел на экран, зачем?
Так же строка 24: Writeln (f,' ');
Тут мы записываем еще один дополнительный пробел в текстовый файл и переходим на новую строку.
Простой переход можно осуществить так: writeln(f);

P.S. Кому интересно, вот исходники "Морского боя" http://rghost.ru/46018602

Строка 22 ничего не решает,

Строка 22 ничего не решает, скорее всего забыл ее удалить когда исправлял недочеты в программе, насчет строки 24: я захотел осуществить переход на новую строку именно таким образом, программа работает и это главное :)

Нужна Ваша помощь...

Валерий Шахамболетович, у меня что-то не очень получается реализовать объектовый тип . Посмотрите пожалуйста...

  1. unit STU;
  2. interface
  3.     type PEL=^EL;
  4.          EL=record
  5.            inf:t;
  6.            nxt:pel;
  7.          end;
  8.          Tstk=object
  9.            private top:pel;
  10.            public
  11.               type t=integer;
  12.               procedure ini;
  13.               procedure push(x:t);//создает первый или добавляет очередной элемент в вершину стека
  14.               function pop:t;//извлекает информацию из вершины стека с освобождением памяти
  15.               function emp:boolean;
  16.          end;
  17.     procedure Tstk.ini;
  18.     begin
  19.      top:=nil;
  20.    end; //создали пустой стек
  21.    procedure Tstk.push(x:t);
  22.     var p:pel;
  23.    begin
  24.      new(p);
  25.      p^.nxt:=top;
  26.      p^.inf:=x;// внесение информации в первый элемент стека
  27.      top:=p;// установка вершины стека на созданный элемент
  28.    end;
  29.    function Tstk.pop:t;
  30.     var p:pel;
  31.    begin
  32.      pop:=top^.inf;//извлечение информации из вершины стека
  33.      p:=top;//установка на вершину стека вспомогательного указателя p
  34.      top:=top^.nxt;//перемещение указателя вершины стека на след элемент
  35.      dispose(p);
  36.    end;
  37.    function Tstk.emp:boolean;
  38.    begin
  39.      Tstk.emp:=(top=nil);
  40.    end;
  41. begin
  42.  Tstk.ini;
  43. end.

Вика

в твоей реализации тип t используется выше точки его определения

  1. unit STU;
  2.  interface
  3.    type t=integer;// тип t обьявляется здесь
  4.          PEL=^EL;
  5.          EL=record
  6.           inf:t;
  7.           nxt:pel;
  8.          end;
  9.          Tstk=object
  10.           private
  11.            top:pel;// указатель скрыт
  12.           public // спецификация методов
  13.            procedure ini;
  14.            procedure push(x:t);
  15.            function pop:t
  16.            function emp:boolean;
  17.          end;
  18.  implementation
  19.   // описание методов
  20.   procedure Tstk.ini;
  21.   begin
  22.     top:=nil;
  23.   end;
  24.  ...
  25.  // инициализационная часть не понадобится
  26. end.

зачем и как используется

зачем и как используется объектовый тип в данном случае, поясните?

Что это и зачем...

Выше описан объектовый тип "стек". В разделе public описаны доступные "действия" (методы работы) с этим объектом. Мы можем использовать их, введя "имя объекта"."имя метода". Например Tstk.Ini; Конкретно сам объект никак не используется, рассматривается только его реализация.

валерий Шахамболетович, еще

валерий Шахамболетович, еще вопрос, будут ли транспортные сети в контрольной по ДМ?

Валерий Шахамболетович,

Например, для первых 2х пуктов будут меняться только юниты (связно-распределенный стек и последовательно-распределенный стек), а главная прог-а будет оставаться такой же, т.е. тот код, который мы писали на 1ой лабараторной по этой теме (где матрица меток, и ввод матрицы смежности)? А как насчет объектного типа..пункт 3.. в роли объекта и будет наш один стек, где мы храним вершины? и всё? не очень ясна эта тема

На Ваши вопросы...

Вика:
1) Насчёт типа t в Вашей реализации Никита прав. И ещё - "полями" определения объектового типа могут быть данные (переменные) и методы, но никак не типы!
2)Транспортных сетей в к.р. по ДМ не предвидится.
Ксения:
В решении задачи об обходе графа основной код, конечно, не зависит от того, объектная или не объектная (т.е. просто юнитная) реализация временного "хранилища" вершин (стека или очереди).
При юнитной реализации, мы напрямую используем стек (или очередь) который, собственно и представляет собой подключаемый юнит:

  1. program Main;
  2. uses Stack; //подключаемый юнит и есть СТЕК!
  3. ...
  4. begin
  5.     //обращаемся к подключённому стеку...
  6.     ini; // или Stack.ini;
  7. ...
  8. end.

При объектной реализации, подключаемый юнит сам по себе не является хранилищем данных (стеком или очередью). Вместо этого, он содержит реализацию стекового типа, на основе которого в программе необходимо описать (создать) конкретный объект (стек), который затем и использовать:
  1. program Main;
  2. uses StackU; //подключаемый юнит  содержит определение стекового типа TStack
  3. Var Stack: TStack; // используя это определение описываем одну стековую переменную
  4. ...
  5. begin
  6.     //... с которой и работаем:
  7.     Stack.ini;
  8. ...
  9. end.

спасибо, я поняла)

спасибо, я поняла)