IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Распаковка сжатого файла, Работа с очередью
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 45
Пол: Мужской

Репутация: -  0  +


Задание такое:
Распаковка сжатого файла.
Файл представляет собой последовательность цепочек вида: <Число><Символ>. Переписать содержимое файла в очередь и преобразовать последовательность по правилу: каждую цепочку заменить на указанное число символов. Например: ‘7a12c4d’ заменяется на ‘aaaaaaaccccccccccccdddd’. Результат записать в выходной файл.

Сделал очередь, из файла читается все нормально. Но абсолютно не могу представить даже приблизительной реализации алгоритма задачи.
Help plz blink.gif

Код

Uses Crt;

Type
  Inf = String;
  Ptr = ^EL;
  EL = record
            Dn : Inf;
            Nx : Ptr;
           end;

  Queue = object
           p : ptr;
           Constructor Init;
           Function Empty : boolean;
           Procedure Push(D : Inf);
           Procedure Print;
           Function Pop : Inf;
           Destructor Done;
           end;


Constructor Queue.Init;
begin
  p := nil
end;

Destructor Queue.Done;
var q : Ptr;
begin
  while p <> nil do
  begin
     q := p;
     p := p^.Nx;
     dispose(q);
  end;
  p := nil;
end;

Function Queue.Empty : boolean;
begin
  If p = nil then
  Empty := false
  else Empty := true;
end;

Procedure Queue.Push(D : Inf);
var q : Ptr;
begin
  New(q);
  q^.Dn := D;
  q^.Nx := p;
  p := q;
end;

Function Queue.Pop : Inf;
var q : Ptr;
begin
  q := p;
  If q^.Nx = nil then
  begin
     Pop := q^.Dn;
     dispose(q);
     p := nil;
  end;

  While q^.Nx^.Nx <> nil do q := q^.Nx;
  Pop := q^.Dn;
  dispose (q^.Nx);
  q^.Nx := nil;
end;

Procedure Queue.Print;
var q : Ptr;
begin
  q := p;
  while q <> nil do
  begin
     write(q^.Dn : 4, ' ');
     q := q^.Nx;
  end;
  writeln;
end;

var   Q1 : Queue;
     input, output : text;
     s, sl : string;
     i, code : integer;

 BEGIN

   ClrScr;
   assign(input, 'input.txt');
   reset(input);
   assign(output, 'output.txt');
   rewrite(output);
   Q1.Init;
   writeln('DO= ',MemAvail);
   writeln;
   While not EOF(input) do
     begin
        sl := '';
        readln(input, s);
        If s[length(s)] <> ' '
        then s := s + ' ';
        For i := 1 to length(s) do
        If s[i] <> ' '
        then
           sl := sl + s[i]
        else
        If length(sl) <> 0 then
        begin
           Q1.Push(sl);
           sl := '';
        end;
     end;

   Q1.Print;
   Q1.Done;
   Close(input);
   writeln;
   writeln('POSLE= ',MemAvail);
   readkey;

END.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






FENIX,
есть 2 пути:
1 - я могу конечно выслать тебе файл, которого не хватает, но это навряд ли тебе поможет, т. к. скорее всего, эту программу просто не примут...
2 - переделаем чуть-чуть твою программу так, чтобы она работала с моим типом TRec:
Код
type
 ttype = word;

 ptitem = ^titem;
 titem =
   record
     data: ttype;
     next: ptitem;
   end;

 tqueue = object
   head, tail: ptitem;
   constructor init;
   destructor done;

   procedure put(x: ttype);
   function get: ttype;

   function empty: boolean;
   procedure print;
 end;


constructor tqueue.init;
begin
 head := nil; tail := nil;
end;
destructor tqueue.done;
begin
 while not empty do get
end;

procedure tqueue.put(x: ttype);
var p: ptitem;
begin
 new(p);
 p^.data := x;
 p^.next := nil;
 if empty then head := p
 else tail^.next := p;
 tail := p
end;

function tqueue.get: ttype;
var p: ptitem;
begin
 if not empty then begin
   p := head;
   head := head^.next;

   get := p^.data;
   dispose(p);
 end
 else begin
   writeln('reading from empty queue');
   halt(102)
 end;
end;

function tqueue.empty: boolean;
begin
 empty := not assigned(head)
end;

procedure tqueue.print;
var p: ptitem;
begin
 p := head;
 write('(queue) <');
 while assigned(p) do begin
   write(p^.data, ' ');
   p := p^.next
 end;
 writeln('>')
end;

{
 Вот до этого места - все, как у тебя -
 очередь которая работает с Word-ами
}

{ А вот дальше... }
type
{
 определяем запись в которой поля count и ch
 хранятся там же, где и поле to_queue (они физически
 занимают одно место в памяти).
 Это называется запись с селектором
}
 trec = record
 case boolean of
   false: (count: byte; ch: char);
   true : (to_queue: word);
 end;

var
 q: tqueue;
 f: text;

procedure convert_str(s: string);
var
 i, err: integer;
 to_number: string;
 r: trec;
begin
 i := 1; to_number := '';
 while i <= length(s) do begin
   while s[i] in ['0' .. '9'] do
     begin
       to_number := to_number + s[i];
       inc(i);
     end;
   val(to_number, r.count, err);
   to_number := '';
   r.ch := s[i]; inc(i);

   q.put(r.to_queue)
{
 пишем то мы содержимое поля to_queue, но
 эффект такой, как будто мы записали другие 2 поля
}
 end;

end;

var
 s: string;
 i: integer;
 rec: trec;

begin
 assign(f, 'fenix.txt');
 {$i-} reset(f); {$i+}

 q.init;
 while not eof(f) do begin
   readln(f, s);
   convert_str(s)
 end;

 while not q.empty do
   begin
{
 то же самое и с чтением, читаем вроде бы Word,
 но на самом деле рассматриваем его как Byte + Char
}
     rec.to_queue := q.get;
     for i := 1 to rec.count do
       write(rec.ch);
   end;

 q.done;
 close(f)
end.

Что не понятно - спрашивай ;)
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 6.09.2025 3:16
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name