Список слов распечатать в алфавитном порядке. В Turbo Pascal или Pascal ABC

@ST2502 · Регистрация: 23.02.2013

Студворк — интернет-сервис помощи студентам

Дана непустая последовательность слов, в каждом из которых содержится от 1 до 6 заглавных латинских букв; соседние слова разделены запятой, за последним словом следует точка. В качестве внутреннего представления последовательности слов использовать массив из 6 списков, в котором хранятся 5-буквенные слова, упорядоченные по алфавиту.
Требуется ввести эту последовательность слов в память ЭВМ, преобразовав ее во внутреннее представление, а затем распечатать в алфавитном порядке: сначала все однобуквенные слова, затем все двубуквенные и т.д.
В программе должны быть определены процедура выделения очередного слова из исходной последовательности и процедура вставки слова в упорядоченный список. Вводить последовательность слов следует посимвольно. Следует упорядочивать списки одновременно с вводом слов: введенное слово следует сразу вставлять в "свое" место в ранее упорядоченный список. Для упрощения рекомендуется использовать списки с заглавными звеньями. В этом случае следует в начале выполнения программы построить список(списки) с одним заглавным звеном. В звеньях списков(вершинах) следует хранить не только слова, но и дополнительную информацию(порядковый номер слова в исходной последовательности или число его вхождений в эту последовательность). Для каждого слова лучше иметь только одно звено, фиксируя в нем число вхождений этого слова в последовательность; при печати же надо продублировать слово данное число раз.

Я понимаю, что условий много))) но без всех этих условий у меня не примут работу. Лично от меня условие написать по возможности комментарии, чтобы мне самой понять ее))))

@Mawrat · 23.02.2013, 22:02

Здесь заглавный элемент в списках я не стал использовать - в этом нет особого смысла.

Pascal

program Project1;
 
uses
  Crt;
 
type
  {Тип основных данных списка.}
  TData = record
    S : String; {Слово.}
    Cnt : Integer; {Счётчик - сколько раз слово S присутствует в тексте.}
  end;
  {Тип указателя на элемент списка.}
  TPElem = ^TElem;
  {Тип элемента списка.}
  TElem = record
    Data : TData; {Основные данные элемента.}
    PNext : TPElem; {Указатель на следующий элемент списка.}
  end;
 
{Добавление элемента в однонаправленный упорядоченный список.
Список упорядочен по возрастанию (т. е. по алфавиту в соответствие
с действующей кодировочной таблицей.}
procedure Add(var aPList : TPElem; const aStr : String);
var
  PNew, PPrev, PCur : TPElem;
begin
  {Указатель на предыдущий элемент.}
  PPrev := nil;
  {Указатель на текущий элемент.}
  PCur := aPList;
  {Ищем позицию для вставки нового элемента. Новый элемент вставляется
  между элементами PPrev и PCur.}
  while (PCur <> nil) and (PCur^.Data.S < aStr) do begin
    {Переходим к следующему элементу.}
    PPrev := PCur;
    PCur := PCur^.PNext;
  end;
  {Вставка элемента в список.}
  {Вставка элемента в конец списка. В этом случае PPrev является указателем
  на последний элемент списка.}
  if PCur = nil then begin
    New(PNew);
    PNew^.Data.S := aStr;
    PNew^.Data.Cnt := 1;
    PNew^.PNext := nil;
    {Если список пуст, то новый элемент становится единственным
    элементом списка.}
    if PPrev = nil then
      aPlist := PNew
    {Если список непустой, то новый элемент добавляем после последнего
    элемента списка.}
    else
      PPrev^.PNext := PNew;
  {Найдено такое же слово. В этом случае вместо вставки выполняем
  увеличение счётчика по этому слову.}
  end else if PCur^.Data.S = aStr then
    Inc(PCur^.Data.Cnt)
  {Вставка вначале или внутри списка. В этом случае мы должны вставить новый
  элемент между элементами PPrev и PCur}
  else begin
    New(PNew);
    PNew^.Data.S := aStr;
    PNew^.Data.Cnt := 1;
    PNew^.PNext := PCur;
    if PPrev = nil then {Если вставка в начало списка.}
      aPList := PNew
    else                {Если вставка внутри списка.}
      PPrev^.PNext := PNew;
  end;
end;
 
{Освобождение памяти, занятой под список и инициализация списка.}
procedure Free(var aPList : TPElem);
var
  PDel : TPElem;
begin
  while aPList <> nil do begin
    PDel := aPList;
    aPList := aPList^.PNext;
    Dispose(PDel);
  end;
end;
 
{Распечатка однонаправленного списка.}
procedure WritelnList(const aPList : TPElem);
var
  PElem : TPElem;
  i, j : Integer;
begin
  if aPList = nil then begin
    Writeln('Список пуст.');
    Exit;
  end;
 
  PElem := aPList;
  i := 0;
  while PElem <> nil do begin
    {Распечатываем текущее слово PElem^.Data.Cnt раз.}
    for j := 1 to PElem^.Data.Cnt do begin
      Inc(i); {Счётчик распечатанных слов.}
      if i > 1 then Write(', ');
      Write(PElem^.Data.S);
    end;
    PElem := PElem^.PNext;
  end;
  Writeln;
end;
 
{Выделение слова из входной последовательности.
Функция работает так. Если введён символ отличный от разделителя, то
этот символ добавляется к строке aStr и распечатывается на экране.
После этого выполняется чтение следующего символа с консоли ввода.
Если введён разделитель, то он обрабатывается, затем функция завершает
работу и возвращает в качестве своего значения этот разделитель.
Через параметр aStr функция возвращает слово - непрерывную последовательность
символов, отличных от разделителей.}
function GetWord(var aStr : String) : Char;
const
  {Множество разделителей слов.}
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #0, #8, #9, #10, #13, #27];
var
  Ch : Char;
begin
  aStr := '';
  repeat
    Ch := Readkey;
    if not (Ch in D) then begin
      aStr := aStr + Ch;
      Write(Ch);
    end else if Ch = #13 then
      Writeln
    else if Ch = #0 then
      Readkey
    else if not (Ch in [#8, #27]) then
      Write(Ch);
  until Ch in D;
  GetWord := Ch;
end;
 
const
  M = 6;
var
  Arr : array[1..M] of TPElem;
  Ch : Char;
  i : Integer;
  S : String;
begin
  {Начальная инициализация массива.}
  for i := 1 to M do Arr[i] := nil;
 
  repeat
    {Обработка текста, выделение слов, создание списков.}
    Writeln('Задайте текст. Обработаны будут только те слова, которые состоят');
    Writeln('не более, чем из ', M, ' букв. Прекратить ввод - ESC.');
    repeat
      Ch := GetWord(S);
      i := Length(S);
      case i of
        1..M: Add(Arr[i], S);
      end;
    until Ch = #27;
    Writeln;
 
    {Распечатка результатов.}
    Writeln('Результаты:');
    for i := 1 to M do begin
      Writeln('Слова с длиной ', i, ':');
      WritelnList(Arr[i]);
    end;
    Writeln;
 
    {Освобождение памяти, занятой под списки.}
    for i := 1 to M do Free(Arr[i]);
    Writeln('Память, занятая под списки, освобождена.');
 
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

@ST2502 · 23.02.2013, 22:25 **[ТС]**

Mawrat, спасибооо большоее))) оперативно))) а остальные условия учтены?

@Mawrat · 23.02.2013, 23:02

Пожалуйста.

Сообщение от ST2502

а остальные условия учтены?

Да, учтены. По порядку:

Сообщение от ST2502

В качестве внутреннего представления последовательности слов использовать массив из 6 списков, в котором хранятся 5-буквенные слова, упорядоченные по алфавиту.

Это сделано. Только формулировка здесь неверная. Правильно: "... в котором хранятся слова с длинами от 1 до 6, соответственно в списках: Arr[1]..Arr[6]. В каждом списке слова упорядочены по алфавиту."
И ещё уточню - слова хранятся почти по алфавиту.

- Согласно кодировочной таблице. Если работа и идёт в Borland/Turbo Pascal, то действует кодировочная таблица CP866.

Сообщение от ST2502

Требуется ввести эту последовательность слов в память ЭВМ, преобразовав ее во внутреннее представление, а затем распечатать в алфавитном порядке: сначала все однобуквенные слова, затем все двубуквенные и т.д.

Сделано.

Сообщение от ST2502

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

Сделано.

Сообщение от ST2502

Вводить последовательность слов следует посимвольно.

Это тоже реализовано - применена функция Readkey().

Сообщение от ST2502

Следует упорядочивать списки одновременно с вводом слов: введенное слово следует сразу вставлять в "свое" место в ранее упорядоченный список.

Сделано.

Сообщение от ST2502

Для упрощения рекомендуется использовать списки с заглавными звеньями. В этом случае следует в начале выполнения программы построить список(списки) с одним заглавным звеном.

Заглавное звено я не стал делать.

Сообщение от ST2502

В звеньях списков(вершинах) следует хранить не только слова, но и дополнительную информацию(порядковый номер слова в исходной последовательности или число его вхождений в эту последовательность). Для каждого слова лучше иметь только одно звено, фиксируя в нем число вхождений этого слова в последовательность;

Сделано.

Сообщение от ST2502

при печати же надо продублировать слово данное число раз.

И это тоже сделано.

Добавлено через 6 минут
Сейчас ещё проверю...

Добавлено через 1 минуту
Есть проблемы.

Сейчас подправлю...

Добавлено через 17 минут
Исправил. Исправленный код в том же сообщении, выше..

Добавлено через 28 секунд
Проверяй.

@ST2502 · 23.02.2013, 23:02 **[ТС]**

Mawrat, *______* боже, что я бы делала без вас))) еще раз огромное спасибооо)))

@Mawrat · 23.02.2013, 23:07

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

HighPredator · 23.02.2013, 23:08

Не по теме:

Сообщение от ST2502

что я бы делала без вас)

Сидели бы без работы.

@Mawrat · 23.02.2013, 23:14

Сообщение от ST2502

Mawrat, *______* боже, что я бы делала без вас))) еще раз огромное спасибооо)))

Сообщение от HighPredator

Сидели бы без работы.

На самом деле, может выпасть ещё одно испытание - если работодатель попросит дать разъяснения по действиям в программе.

Поэтому в коде надо постараться разобраться.

HighPredator · 23.02.2013, 23:15

Сообщение от Mawrat

На самом деле, может выпасть ещё одно испытание - если работодатель попросит дать разъяснения по действиям программы. Поэтому в коде надо постараться разобраться.

Тоже верно.

@ST2502 · 23.02.2013, 23:23 **[ТС]**

Сообщение от HighPredator

Не по теме:

Сидели бы без работы.

не сидела бы)))

Сообщение от Mawrat

На самом деле, может выпасть ещё одно испытание - если работодатель попросит дать разъяснения по действиям в программе.

Поэтому в коде надо постараться разобраться.

он попросит)) разберусь, вроде все понятно)))

@Mawrat · 23.02.2013, 23:45

ST2502, например, может быть такой вопрос: в функции GetWord() пояснить назначение строк:

Pascal

    end else if Ch = #13 then
      Writeln
    else if Ch = #0 then
      Readkey
    else if Ch <> #8 then
      Write(Ch);

Ответ.
Если введён символ с кодом #13 - то это перевод каретки. Т. е., переход на новую строку. Поэтому мы выполняем вызов Writeln.
Если спросят - а почему бы в этом случае не написать так: Write(Ch) или так: Write(#13)?
Ответ: потому что на самом деле перевод каретки состоит из двух знаков: #13#10 - переход на новую строку и конец строки. Поэтому вместо Writeln можно написать так: Write(#13#10).
Теперь что касается знака #0. Если пользователь нажмёт какую-нибудь функциональную клавишу F1, F2 и т. д., то в этом случае Readkey() вернёт код #0. А при следующем вызове Readkey() вернёт скан-код нажатой клавиши. Поэтому в программе, если вызов Readkey() вернул #0, то значит произошло нажатие функциональной клавиши. В этом случае мы ещё раз вызываем Readkey(), чтобы прочитать скан-код клавиши. Далее этот скан код мы никак не используем, т. к., он нам не нужен.
Знак #8 - это нажатие клавиши BackSpace.

Добавлено через 19 минут
И ещё немного подправил - чтобы символ #27 (ESC) не распечатывался на экране.
Т. е., заменил:

Pascal

1 2	else if Ch <> #8 then Write(Ch);

на:

Pascal

1 2	else if not (Ch in [#8, #27]) then Write(Ch);

Полностью:

Pascal

{Выделение слова из входной последовательности.
Функция работает так. Если введён символ отличный от разделителя, то
этот символ добавляется к строке aStr и распечатывается на экране.
После этого выполняется чтение следующего символа с консоли ввода.
Если введён разделитель, то он обрабатывается, затем функция завершает
работу и возвращает в качестве своего значения этот разделитель.
Через параметр aStr функция возвращает слово - непрерывную последовательность
символов, отличных от разделителей.}
function GetWord(var aStr : String) : Char;
const
  {Множество разделителей слов.}
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #0, #8, #9, #10, #13, #27];
var
  Ch : Char;
begin
  aStr := '';
  repeat
    Ch := Readkey;
    if not (Ch in D) then begin
      aStr := aStr + Ch;
      Write(Ch);
    end else if Ch = #13 then
      Writeln
    else if Ch = #0 then
      Readkey
    else if not (Ch in [#8, #27]) then
      Write(Ch);
  until Ch in D;
  GetWord := Ch;
end;

И ещё добавил Writeln перед распечаткой результатов.
Исправленный код в прежнем сообщении.

@ST2502 · 24.02.2013, 12:19 **[ТС]**

Mawrat, а можно функцию GetWord без этих символов( #0, #8, #9, #10, #13, #27)? так как я не мастер в проге и препод догадается, что я не сама это сделала)))) + "прекратить ввод - esc" можно его заменить просто enter? "Память занятая под списки освобождена" для чего это было сделано? обязателен ли он? "повторить - enter" это тоже не понадобится думаю)) также он читает любые слова менее 6 букв, например, "f f f", "qw//", "а**", "wer**/", хотя он должен читать только слова с латинскими буквами без других символов. можете исправить?))

@Mawrat · 24.02.2013, 12:46

Сообщение от ST2502

а можно функцию GetWord без этих символов( #0, #8, #9, #10, #13, #27)?

Ну в общем, если пользователь обязуется не нажимать функциональные клавиши (F1, F2, и др.), то можно убрать код #0. Код #8 - это клавиша BackSpace - пользователь может попытаться стереть какие-нибудь символы. Поэтому эту клавишу желательно перехватывать. Код #10 можно убрать. #13 - это Enter. А #27 - это ESC.

Сообщение от ST2502

"прекратить ввод - esc" можно его заменить просто enter?

Да, можно и по Enter завершение ввода сделать.

Сообщение от ST2502

"Память занятая под списки освобождена" для чего это было сделано? обязателен ли он?

Раз мы память выделили, то её надо позже освободить. Т. е., раз мы у системы (или у менеджера памяти) взяли память, то потом её надо возвратить. Иначе будут утечки памяти. Т. е. память будет помечена, как используемая в программе, хотя программа к ней уже не будет иметь доступа. Таким образом эту память не сможет использовать менеджер памяти и соответственно, она не будет отдана системе. Ещё такие участки памяти называют "мёртвыми".
Вообще, когда проверяется код программы, где идёт работа с динамической памятью, первое что делается, смотрят - ага есть вызов New(), теперь смотрим - есть ли вызов Dispose()? Нет Dispose() - всё, это уже серьёзный недочёт. Чаще всего, убедившись в отсутствии Dispose(), проверка сразу же и заканчивается.

Сообщение от ST2502

он читает любые слова менее 6 букв, например, "f f f", "qw//", "а**", "wer**/", хотя он должен читать только слова с латинскими буквами без других символов.

Да сейчас "буквами" считаются любые символы, отличные от разделителей. Можно изменить код таким образом, чтобы только буквы латиницы учитывались.
---
В общем я сейчас подправлю. И выложу здесь код чуть позже.

@ST2502 · 24.02.2013, 13:06 **[ТС]**

Сообщение от Mawrat

Ну в общем, если пользователь обязуется не нажимать функциональные клавиши (F1, F2, и др.), то можно убрать код #0.

обязуюсь))

Сообщение от Mawrat

Код #8 - это клавиша BackSpace - пользователь может попытаться стереть какие-нибудь символы. Поэтому эту клавишу желательно перехватывать.

наоборот, мне легче было бы если при неправильном вводе смогла стереть ненужное)))

@Mawrat · 24.02.2013, 13:45

Сообщение от ST2502

наоборот, мне легче было бы если при неправильном вводе смогла стереть ненужное)))

Тогда понадобится поменять алгоритм ввода.

И здесь уже надо будет уточнить тогда. У нас есть два условия:

Сообщение от ST2502

Вводить последовательность слов следует посимвольно.

Сообщение от ST2502

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

У нас сейчас есть функция GetWord(), которая извлекает слова из посимвольного ввода с консоли. И таким образом у нас выполняются оба условия - у нас есть процедура, которая обеспечивает посимвольный ввод и извлечение слов.
Сейчас у пользователя нет возможности редактирования текста, который он вводит. Если мы такую возможность предоставим, то нам понадобится отслеживать изменения, сделанные пользователем. Это сделать можно - мы должны будем хранить всё введённые символы в буфере - в символьном массиве. Если пользователь нажмёт BackSpace (#8), то мы уменьшим значимую длину буфера на 1 - тем самым, удалим последний символ. В течение всего времени ввода текста мы не должны извлекать слова, потому что нам не известно окончательное состояние текста (ведь пользователь может часть слов стереть). Только когда пользователь завершит ввод (нажмёт Enter (#13), например) - вот тогда мы начнём извлекать слова из буфера.
Устроит такой вариант?

Добавлено через 2 минуты
Клавиши стрелок запретим - потому что логика с их участием усложнится.

@ST2502 · 24.02.2013, 15:19 **[ТС]**

Mawrat, окей) не будем тогда усложнять

пусть останется как есть)))

@Mawrat · 24.02.2013, 16:03

Ну я сейчас тогда два варианта программы выложу. Без буфера и с буфером. И можно будет выбрать.

@ST2502 · 24.02.2013, 16:21 **[ТС]**

ок

@Mawrat · 24.02.2013, 16:48

В программе с буфером ввод всё-таки не очень красивым получился. При нажатии BackSpace предыдущие символы не стираются на экране, а только перемещается влево курсор. Но на самом деле они стираются - в буфере.

И если опять начать вводить символы, то новые символы будут на экране затирать старые. В общем, визуально это как-то не очень... Плюс к этому, если на экране началась новая строка, то при нажатии BackSpace курсор на предыдущую строку не возвращается. Хотя при обычном вводе тоже так - на предыдущую строку курсор не возвращается.
Но тем не менее программу с буфером тоже выложил - под номером 2.

---
1. Без буфера, с завершением ввода по нажатию ENTER:

Pascal

program Project1;
 
uses
  Crt;
 
type
  {Тип основных данных списка.}
  TData = record
    S : String; {Слово.}
    Cnt : Integer; {Счётчик - сколько раз слово S присутствует в тексте.}
  end;
  {Тип указателя на элемент списка.}
  TPElem = ^TElem;
  {Тип элемента списка.}
  TElem = record
    Data : TData; {Основные данные элемента.}
    PNext : TPElem; {Указатель на следующий элемент списка.}
  end;
 
{Добавление элемента в однонаправленный упорядоченный список.
Список упорядочен по возрастанию (т. е. по алфавиту в соответствие
с действующей кодировочной таблицей.}
procedure Add(var aPList : TPElem; const aStr : String);
var
  PNew, PPrev, PCur : TPElem;
begin
  {Указатель на предыдущий элемент.}
  PPrev := nil;
  {Указатель на текущий элемент.}
  PCur := aPList;
  {Ищем позицию для вставки нового элемента. Новый элемент вставляется
  между элементами PPrev и PCur.}
  while (PCur <> nil) and (PCur^.Data.S < aStr) do begin
    {Переходим к следующему элементу.}
    PPrev := PCur;
    PCur := PCur^.PNext;
  end;
  {Вставка элемента в список.}
  {Вставка элемента в конец списка. В этом случае PPrev является указателем
  на последний элемент списка.}
  if PCur = nil then begin
    New(PNew);
    PNew^.Data.S := aStr;
    PNew^.Data.Cnt := 1;
    PNew^.PNext := nil;
    {Если список пуст, то новый элемент становится единственным
    элементом списка.}
    if PPrev = nil then
      aPlist := PNew
    {Если список непустой, то новый элемент добавляем после последнего
    элемента списка.}
    else
      PPrev^.PNext := PNew;
  {Найдено такое же слово. В этом случае вместо вставки выполняем
  увеличение счётчика по этому слову.}
  end else if PCur^.Data.S = aStr then
    Inc(PCur^.Data.Cnt)
  {Вставка вначале или внутри списка. В этом случае мы должны вставить новый
  элемент между элементами PPrev и PCur}
  else begin
    New(PNew);
    PNew^.Data.S := aStr;
    PNew^.Data.Cnt := 1;
    PNew^.PNext := PCur;
    if PPrev = nil then {Если вставка в начало списка.}
      aPList := PNew
    else                {Если вставка внутри списка.}
      PPrev^.PNext := PNew;
  end;
end;
 
{Освобождение памяти, занятой под список и инициализация списка.}
procedure Free(var aPList : TPElem);
var
  PDel : TPElem;
begin
  while aPList <> nil do begin
    PDel := aPList;
    aPList := aPList^.PNext;
    Dispose(PDel);
  end;
end;
 
{Распечатка однонаправленного списка.}
procedure WritelnList(const aPList : TPElem);
var
  PElem : TPElem;
  i, j : Integer;
begin
  if aPList = nil then begin
    Writeln('Список пуст.');
    Exit;
  end;
 
  PElem := aPList;
  i := 0;
  while PElem <> nil do begin
    {Распечатываем текущее слово PElem^.Data.Cnt раз.}
    for j := 1 to PElem^.Data.Cnt do begin
      Inc(i); {Счётчик распечатанных слов.}
      if i > 1 then Write(', ');
      Write(PElem^.Data.S);
    end;
    PElem := PElem^.PNext;
  end;
  Writeln;
end;
 
{Выделение слова из входной последовательности.
Функция работает так. Если введён символ из множества Da, то этот символ
добавляется к строке aStr и распечатывается на экране. После этого выполняется
чтение следующего символа с консоли ввода. Если введён символ,
не принадлежащий множеству Da, то он дополнительно обрабатывается, если
требуется. Затем функция завершает работу и возвращает в качестве своего
значения этот символ.
Через параметр aStr функция возвращает слово - непрерывную последовательность
символов, принадлежащих множеству Da.}
function GetWord(var aStr : String) : Char;
const
  {Множество букв латиницы.}
  Da = ['A'..'Z', 'a'..'z'];
var
  Ch : Char;
  F : Boolean;
begin
  aStr := '';
  repeat
    Ch := Readkey;
    F := True; {Завершить цикл чтения с консоли.}
    if Ch in Da then begin
      aStr := aStr + Ch;
      Write(Ch);
      F := False; {Продолжить цикл чтения с консоли.}
    end else if Ch in [#8, #27] then
      F := False  {Продолжить цикл чтения с консоли.}
    else if Ch in [#0] then begin
      Readkey;
      F := False; {Продолжить цикл чтения с консоли.}
    end else if Ch = #13 then
      Writeln
    else
      Write(Ch);
  until F;
  GetWord := Ch;
end;
 
const
  M = 6;
var
  Arr : array[1..M] of TPElem;
  Ch : Char;
  i : Integer;
  S : String;
begin
  {Начальная инициализация массива.}
  for i := 1 to M do Arr[i] := nil;
 
  repeat
    {Обработка текста, выделение слов, создание списков.}
    Writeln('Задайте текст. Обработаны будут только те слова, которые состоят');
    Writeln('не более, чем из ', M, ' букв. Прекратить ввод - ESC.');
    repeat
      Ch := GetWord(S);
      i := Length(S);
      case i of
        1..M: Add(Arr[i], S);
      end;
    until Ch = #13;
    Writeln;
 
    {Распечатка результатов.}
    Writeln('Результаты:');
    for i := 1 to M do begin
      Writeln('Слова с длиной ', i, ':');
      WritelnList(Arr[i]);
    end;
    Writeln;
 
    {Освобождение памяти, занятой под списки.}
    for i := 1 to M do Free(Arr[i]);
    Writeln('Память, занятая под списки, освобождена.');
 
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

2. С буфером. Завершение ввода по нажатию ENTER. BackSpace работает, но визуально символы не стираются.

Pascal

program Project1;
 
uses
  Crt;
 
type
  {Тип основных данных списка.}
  TData = record
    S : String; {Слово.}
    Cnt : Integer; {Счётчик - сколько раз слово S присутствует в тексте.}
  end;
  {Тип указателя на элемент списка.}
  TPElem = ^TElem;
  {Тип элемента списка.}
  TElem = record
    Data : TData; {Основные данные элемента.}
    PNext : TPElem; {Указатель на следующий элемент списка.}
  end;
 
{Добавление элемента в однонаправленный упорядоченный список.
Список упорядочен по возрастанию (т. е. по алфавиту в соответствие
с действующей кодировочной таблицей.}
procedure Add(var aPList : TPElem; const aStr : String);
var
  PNew, PPrev, PCur : TPElem;
begin
  {Указатель на предыдущий элемент.}
  PPrev := nil;
  {Указатель на текущий элемент.}
  PCur := aPList;
  {Ищем позицию для вставки нового элемента. Новый элемент вставляется
  между элементами PPrev и PCur.}
  while (PCur <> nil) and (PCur^.Data.S < aStr) do begin
    {Переходим к следующему элементу.}
    PPrev := PCur;
    PCur := PCur^.PNext;
  end;
  {Вставка элемента в список.}
  {Вставка элемента в конец списка. В этом случае PPrev является указателем
  на последний элемент списка.}
  if PCur = nil then begin
    New(PNew);
    PNew^.Data.S := aStr;
    PNew^.Data.Cnt := 1;
    PNew^.PNext := nil;
    {Если список пуст, то новый элемент становится единственным
    элементом списка.}
    if PPrev = nil then
      aPlist := PNew
    {Если список непустой, то новый элемент добавляем после последнего
    элемента списка.}
    else
      PPrev^.PNext := PNew;
  {Найдено такое же слово. В этом случае вместо вставки выполняем
  увеличение счётчика по этому слову.}
  end else if PCur^.Data.S = aStr then
    Inc(PCur^.Data.Cnt)
  {Вставка вначале или внутри списка. В этом случае мы должны вставить новый
  элемент между элементами PPrev и PCur}
  else begin
    New(PNew);
    PNew^.Data.S := aStr;
    PNew^.Data.Cnt := 1;
    PNew^.PNext := PCur;
    if PPrev = nil then {Если вставка в начало списка.}
      aPList := PNew
    else                {Если вставка внутри списка.}
      PPrev^.PNext := PNew;
  end;
end;
 
{Освобождение памяти, занятой под список и инициализация списка.}
procedure Free(var aPList : TPElem);
var
  PDel : TPElem;
begin
  while aPList <> nil do begin
    PDel := aPList;
    aPList := aPList^.PNext;
    Dispose(PDel);
  end;
end;
 
{Распечатка однонаправленного списка.}
procedure WritelnList(const aPList : TPElem);
var
  PElem : TPElem;
  i, j : Integer;
begin
  if aPList = nil then begin
    Writeln('Список пуст.');
    Exit;
  end;
 
  PElem := aPList;
  i := 0;
  while PElem <> nil do begin
    {Распечатываем текущее слово PElem^.Data.Cnt раз.}
    for j := 1 to PElem^.Data.Cnt do begin
      Inc(i); {Счётчик распечатанных слов.}
      if i > 1 then Write(', ');
      Write(PElem^.Data.S);
    end;
    PElem := PElem^.PNext;
  end;
  Writeln;
end;
 
const
  N = 10000; {Размер текстового буфера.}
type
  TArrTxt = array[1..N] of Char; {Тип текстового буфера.}
 
procedure InputText(var aArr : TArrTxt; var aSize : Integer);
var
  Ch : Char;
  h : Integer;
  F : Boolean;
begin
  h := High(aArr); {Верхний индекс массива.}
  repeat
    Ch := Readkey;
    F := True; {Завершить цикл чтения с консоли.}
    if Ch = #8 then begin
      Write(Ch);
      if aSize > 0 then Dec(aSize);
    end else if Ch = #0 then
      Readkey
    else if Ch = #13 then
      Writeln
    else begin
      if aSize < h then begin
        Write(Ch);
        Inc(aSize);
        aArr[aSize] := Ch;
      end;
    end;
  until Ch in [#10, #13];
end;
 
{Выделение очередного слова из входной последовательности.}
function GetWord(const aArr : TArrTxt; var aSize, aInd : Integer) : String;
const
  {Множество букв латиницы.}
  Da = ['A'..'Z', 'a'..'z'];
var
  i : Integer;
  S : String;
  F : Boolean;
begin
  F := True;
  S := '';
  while (aInd <= aSize) and F do begin
    {Если обнаружена буква, то добавляем её к слову.}
    if aArr[aInd] in Da then
      S := S + aArr[aInd]
    {Если символ не является буквой и слово непустое,
    значит найден конец    слова.}
    else if S <> '' then
      F := False;
    Inc(aInd);
  end;
  GetWord := S;
end;
 
const
  M = 6;
var
  Arr : array[1..M] of TPElem;
  ArrTxt : TArrTxt; {Текстовый буфер.}
  i, Size, Len : Integer;
  S : String;
begin
  {Начальная инициализация массива.}
  for i := 1 to M do Arr[i] := nil;
 
  repeat
    {Ввод текста.}
    Writeln('Задайте текст. Обработаны будут только те слова, которые состоят');
    Writeln('не более, чем из ', M, ' букв. Прекратить ввод - ENTER.');
    Size := 0;
    InputText(ArrTxt, Size);
 
    {Обработка текста, выделение слов, создание списков.}
    i := 1;
    repeat
      S := GetWord(ArrTxt, Size, i);
      Len := Length(S);
      case Len of
        1..M: Add(Arr[Len], S);
      end;
    until Len = 0;
 
    {Распечатка результатов.}
    Writeln('Результаты:');
    for i := 1 to M do begin
      Writeln('Слова с длиной ', i, ':');
      WritelnList(Arr[i]);
    end;
    Writeln;
 
    {Освобождение памяти, занятой под списки.}
    for i := 1 to M do Free(Arr[i]);
    Writeln('Память, занятая под списки, освобождена.');
 
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

3. С обыкновенным вводом. Т. е., здесь вводится вся строка целиком и ввод не является посимвольным.

Pascal

program Project1;
 
uses
  Crt;
 
type
  {Тип основных данных списка.}
  TData = record
    S : String; {Слово.}
    Cnt : Integer; {Счётчик - сколько раз слово S присутствует в тексте.}
  end;
  {Тип указателя на элемент списка.}
  TPElem = ^TElem;
  {Тип элемента списка.}
  TElem = record
    Data : TData; {Основные данные элемента.}
    PNext : TPElem; {Указатель на следующий элемент списка.}
  end;
 
{Добавление элемента в однонаправленный упорядоченный список.
Список упорядочен по возрастанию (т. е. по алфавиту в соответствие
с действующей кодировочной таблицей.}
procedure Add(var aPList : TPElem; const aStr : String);
var
  PNew, PPrev, PCur : TPElem;
begin
  {Указатель на предыдущий элемент.}
  PPrev := nil;
  {Указатель на текущий элемент.}
  PCur := aPList;
  {Ищем позицию для вставки нового элемента. Новый элемент вставляется
  между элементами PPrev и PCur.}
  while (PCur <> nil) and (PCur^.Data.S < aStr) do begin
    {Переходим к следующему элементу.}
    PPrev := PCur;
    PCur := PCur^.PNext;
  end;
  {Вставка элемента в список.}
  {Вставка элемента в конец списка. В этом случае PPrev является указателем
  на последний элемент списка.}
  if PCur = nil then begin
    New(PNew);
    PNew^.Data.S := aStr;
    PNew^.Data.Cnt := 1;
    PNew^.PNext := nil;
    {Если список пуст, то новый элемент становится единственным
    элементом списка.}
    if PPrev = nil then
      aPlist := PNew
    {Если список непустой, то новый элемент добавляем после последнего
    элемента списка.}
    else
      PPrev^.PNext := PNew;
  {Найдено такое же слово. В этом случае вместо вставки выполняем
  увеличение счётчика по этому слову.}
  end else if PCur^.Data.S = aStr then
    Inc(PCur^.Data.Cnt)
  {Вставка вначале или внутри списка. В этом случае мы должны вставить новый
  элемент между элементами PPrev и PCur}
  else begin
    New(PNew);
    PNew^.Data.S := aStr;
    PNew^.Data.Cnt := 1;
    PNew^.PNext := PCur;
    if PPrev = nil then {Если вставка в начало списка.}
      aPList := PNew
    else                {Если вставка внутри списка.}
      PPrev^.PNext := PNew;
  end;
end;
 
{Освобождение памяти, занятой под список и инициализация списка.}
procedure Free(var aPList : TPElem);
var
  PDel : TPElem;
begin
  while aPList <> nil do begin
    PDel := aPList;
    aPList := aPList^.PNext;
    Dispose(PDel);
  end;
end;
 
{Распечатка однонаправленного списка.}
procedure WritelnList(const aPList : TPElem);
var
  PElem : TPElem;
  i, j : Integer;
begin
  if aPList = nil then begin
    Writeln('Список пуст.');
    Exit;
  end;
 
  PElem := aPList;
  i := 0;
  while PElem <> nil do begin
    {Распечатываем текущее слово PElem^.Data.Cnt раз.}
    for j := 1 to PElem^.Data.Cnt do begin
      Inc(i); {Счётчик распечатанных слов.}
      if i > 1 then Write(', ');
      Write(PElem^.Data.S);
    end;
    PElem := PElem^.PNext;
  end;
  Writeln;
end;
 
{Выделение очередного слова из входной последовательности.}
function GetWord(const aStr : String; var aSize, aInd : Integer) : String;
const
  {Множество букв латиницы.}
  Da = ['A'..'Z', 'a'..'z'];
var
  i : Integer;
  S : String;
  F : Boolean;
begin
  F := True;
  S := '';
  while (aInd <= aSize) and F do begin
    {Если обнаружена буква, то добавляем её к слову.}
    if aStr[aInd] in Da then
      S := S + aStr[aInd]
    {Если символ не является буквой и слово непустое,
    значит найден конец    слова.}
    else if S <> '' then
      F := False;
    Inc(aInd);
  end;
  GetWord := S;
end;
 
const
  M = 6;
var
  Arr : array[1..M] of TPElem;
  Txt : String; {Текст, заданный пользователем.}
  i, Size, Len : Integer;
  S : String;
begin
  {Начальная инициализация массива.}
  for i := 1 to M do Arr[i] := nil;
 
  repeat
    {Ввод текста.}
    Writeln('Задайте текст. Обработаны будут только те слова, которые состоят');
    Writeln('не более, чем из ', M, ' букв. Прекратить ввод - ENTER.');
    Readln(Txt);
    Size := Length(Txt);
 
    {Обработка текста, выделение слов, создание списков.}
    i := 1;
    repeat
      S := GetWord(Txt, Size, i);
      Len := Length(S);
      case Len of
        1..M: Add(Arr[Len], S);
      end;
    until Len = 0;
 
    {Распечатка результатов.}
    Writeln('Результаты:');
    for i := 1 to M do begin
      Writeln('Слова с длиной ', i, ':');
      WritelnList(Arr[i]);
    end;
    Writeln;
 
    {Освобождение памяти, занятой под списки.}
    for i := 1 to M do Free(Arr[i]);
    Writeln('Память, занятая под списки, освобождена.');
 
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

Добавлено через 4 минуты
Обработку функциональных клавиш я всё-таки оставил. - Чтобы клавиши "стрелки" перехватывать. Если стрелки нажиматься гарантированно не будут, то надо просто в функции GetWord() убрать часть с условием:

Pascal

1	else if Ch in [#0] then begin

В программе с буфером этот код расположен в процедуре InputText().

@ST2502 · 24.02.2013, 17:26 **[ТС]**

Mawrat, *_____* самое то для меня это 3 вариант)))) спасибо огромное-огромное)))

Добавлено через 3 минуты
Mawrat, можете посмотреть еще эту задачку? она похожая)) мб это через чур))) но все же)) Задача на списки

@ST2502 0 / 0 / 0 Регистрация: 23.02.2013 Сообщений: 12
	24.02.2013, 16:21 [ТС]	18
	ок 0

@ST2502 0 / 0 / 0 Регистрация: 23.02.2013 Сообщений: 12
	23.02.2013, 22:25 [ТС]	3
	Mawrat, спасибооо большоее))) оперативно))) а остальные условия учтены? 0

@Mawrat 13100 / 5881 / 1706 Регистрация: 19.09.2009 Сообщений: 8,808
	23.02.2013, 23:02	4
	Пожалуйста. Сообщение от ST2502 а остальные условия учтены? Да, учтены. По порядку: Сообщение от ST2502 В качестве внутреннего представления последовательности слов использовать массив из 6 списков, в котором хранятся 5-буквенные слова, упорядоченные по алфавиту. Это сделано. Только формулировка здесь неверная. Правильно: "... в котором хранятся слова с длинами от 1 до 6, соответственно в списках: Arr[1]..Arr[6]. В каждом списке слова упорядочены по алфавиту." И ещё уточню - слова хранятся почти по алфавиту. - Согласно кодировочной таблице. Если работа и идёт в Borland/Turbo Pascal, то действует кодировочная таблица CP866. Сообщение от ST2502 Требуется ввести эту последовательность слов в память ЭВМ, преобразовав ее во внутреннее представление, а затем распечатать в алфавитном порядке: сначала все однобуквенные слова, затем все двубуквенные и т.д. Сделано. Сообщение от ST2502 В программе должны быть определены процедура выделения очередного слова из исходной последовательности и процедура вставки слова в упорядоченный список. Сделано. Сообщение от ST2502 Вводить последовательность слов следует посимвольно. Это тоже реализовано - применена функция Readkey(). Сообщение от ST2502 Следует упорядочивать списки одновременно с вводом слов: введенное слово следует сразу вставлять в "свое" место в ранее упорядоченный список. Сделано. Сообщение от ST2502 Для упрощения рекомендуется использовать списки с заглавными звеньями. В этом случае следует в начале выполнения программы построить список(списки) с одним заглавным звеном. Заглавное звено я не стал делать. Сообщение от ST2502 В звеньях списков(вершинах) следует хранить не только слова, но и дополнительную информацию(порядковый номер слова в исходной последовательности или число его вхождений в эту последовательность). Для каждого слова лучше иметь только одно звено, фиксируя в нем число вхождений этого слова в последовательность; Сделано. Сообщение от ST2502 при печати же надо продублировать слово данное число раз. И это тоже сделано. Добавлено через 6 минут Сейчас ещё проверю... Добавлено через 1 минуту Есть проблемы. Сейчас подправлю... Добавлено через 17 минут Исправил. Исправленный код в том же сообщении, выше.. Добавлено через 28 секунд Проверяй. 2

@ST2502 0 / 0 / 0 Регистрация: 23.02.2013 Сообщений: 12
	23.02.2013, 23:02 [ТС]	5
	Mawrat, ______ боже, что я бы делала без вас))) еще раз огромное спасибооо))) 0

@Mawrat 13100 / 5881 / 1706 Регистрация: 19.09.2009 Сообщений: 8,808
	23.02.2013, 23:07	6
	Если в программе что-то непонятно - спрашивай. Расскажу. Вообще, что касается списков, желательно рисовать элементы и их связи на бумаге - так легче разобраться, что происходит при действиях со списком. 2

HighPredator
	23.02.2013, 23:08 #7
	Не по теме: Сообщение от ST2502 что я бы делала без вас) Сидели бы без работы. 0

@Mawrat 13100 / 5881 / 1706 Регистрация: 19.09.2009 Сообщений: 8,808
	23.02.2013, 23:14	8
	Сообщение от ST2502 Mawrat, ______ боже, что я бы делала без вас))) еще раз огромное спасибооо))) Сообщение от HighPredator Сидели бы без работы. На самом деле, может выпасть ещё одно испытание - если работодатель попросит дать разъяснения по действиям в программе. Поэтому в коде надо постараться разобраться. 0

HighPredator 6044 / 2159 / 753 Регистрация: 10.12.2010 Сообщений: 6,005 Записей в блоге: 3
	23.02.2013, 23:15	9
	Сообщение от Mawrat На самом деле, может выпасть ещё одно испытание - если работодатель попросит дать разъяснения по действиям программы. Поэтому в коде надо постараться разобраться. Тоже верно. 2

@ST2502 0 / 0 / 0 Регистрация: 23.02.2013 Сообщений: 12
	23.02.2013, 23:23 [ТС]	10
	Сообщение от HighPredator Не по теме: Сидели бы без работы. не сидела бы))) Сообщение от Mawrat На самом деле, может выпасть ещё одно испытание - если работодатель попросит дать разъяснения по действиям в программе. Поэтому в коде надо постараться разобраться. он попросит)) разберусь, вроде все понятно))) 0

@ST2502 0 / 0 / 0 Регистрация: 23.02.2013 Сообщений: 12
	24.02.2013, 12:19 [ТС]	12
	Mawrat, а можно функцию GetWord без этих символов( #0, #8, #9, #10, #13, #27)? так как я не мастер в проге и препод догадается, что я не сама это сделала)))) + "прекратить ввод - esc" можно его заменить просто enter? "Память занятая под списки освобождена" для чего это было сделано? обязателен ли он? "повторить - enter" это тоже не понадобится думаю)) также он читает любые слова менее 6 букв, например, "f f f", "qw//", "а", "wer/", хотя он должен читать только слова с латинскими буквами без других символов. можете исправить?)) 0

@Mawrat 13100 / 5881 / 1706 Регистрация: 19.09.2009 Сообщений: 8,808
	24.02.2013, 12:46	13
	Сообщение от ST2502 а можно функцию GetWord без этих символов( #0, #8, #9, #10, #13, #27)? Ну в общем, если пользователь обязуется не нажимать функциональные клавиши (F1, F2, и др.), то можно убрать код #0. Код #8 - это клавиша BackSpace - пользователь может попытаться стереть какие-нибудь символы. Поэтому эту клавишу желательно перехватывать. Код #10 можно убрать. #13 - это Enter. А #27 - это ESC. Сообщение от ST2502 "прекратить ввод - esc" можно его заменить просто enter? Да, можно и по Enter завершение ввода сделать. Сообщение от ST2502 "Память занятая под списки освобождена" для чего это было сделано? обязателен ли он? Раз мы память выделили, то её надо позже освободить. Т. е., раз мы у системы (или у менеджера памяти) взяли память, то потом её надо возвратить. Иначе будут утечки памяти. Т. е. память будет помечена, как используемая в программе, хотя программа к ней уже не будет иметь доступа. Таким образом эту память не сможет использовать менеджер памяти и соответственно, она не будет отдана системе. Ещё такие участки памяти называют "мёртвыми". Вообще, когда проверяется код программы, где идёт работа с динамической памятью, первое что делается, смотрят - ага есть вызов New(), теперь смотрим - есть ли вызов Dispose()? Нет Dispose() - всё, это уже серьёзный недочёт. Чаще всего, убедившись в отсутствии Dispose(), проверка сразу же и заканчивается. Сообщение от ST2502 он читает любые слова менее 6 букв, например, "f f f", "qw//", "а", "wer/", хотя он должен читать только слова с латинскими буквами без других символов. Да сейчас "буквами" считаются любые символы, отличные от разделителей. Можно изменить код таким образом, чтобы только буквы латиницы учитывались. --- В общем я сейчас подправлю. И выложу здесь код чуть позже. 1

@ST2502 0 / 0 / 0 Регистрация: 23.02.2013 Сообщений: 12
	24.02.2013, 13:06 [ТС]	14
	Сообщение от Mawrat Ну в общем, если пользователь обязуется не нажимать функциональные клавиши (F1, F2, и др.), то можно убрать код #0. обязуюсь)) Сообщение от Mawrat Код #8 - это клавиша BackSpace - пользователь может попытаться стереть какие-нибудь символы. Поэтому эту клавишу желательно перехватывать. наоборот, мне легче было бы если при неправильном вводе смогла стереть ненужное))) 0

@Mawrat 13100 / 5881 / 1706 Регистрация: 19.09.2009 Сообщений: 8,808
	24.02.2013, 13:45	15
	Сообщение от ST2502 наоборот, мне легче было бы если при неправильном вводе смогла стереть ненужное))) Тогда понадобится поменять алгоритм ввода. И здесь уже надо будет уточнить тогда. У нас есть два условия: Сообщение от ST2502 Вводить последовательность слов следует посимвольно. Сообщение от ST2502 В программе должны быть определены процедура выделения очередного слова из исходной последовательности У нас сейчас есть функция GetWord(), которая извлекает слова из посимвольного ввода с консоли. И таким образом у нас выполняются оба условия - у нас есть процедура, которая обеспечивает посимвольный ввод и извлечение слов. Сейчас у пользователя нет возможности редактирования текста, который он вводит. Если мы такую возможность предоставим, то нам понадобится отслеживать изменения, сделанные пользователем. Это сделать можно - мы должны будем хранить всё введённые символы в буфере - в символьном массиве. Если пользователь нажмёт BackSpace (#8), то мы уменьшим значимую длину буфера на 1 - тем самым, удалим последний символ. В течение всего времени ввода текста мы не должны извлекать слова, потому что нам не известно окончательное состояние текста (ведь пользователь может часть слов стереть). Только когда пользователь завершит ввод (нажмёт Enter (#13), например) - вот тогда мы начнём извлекать слова из буфера. Устроит такой вариант? Добавлено через 2 минуты Клавиши стрелок запретим - потому что логика с их участием усложнится. 0

@ST2502 0 / 0 / 0 Регистрация: 23.02.2013 Сообщений: 12
	24.02.2013, 15:19 [ТС]	16
	Mawrat, окей) не будем тогда усложнять пусть останется как есть))) 0

@Mawrat 13100 / 5881 / 1706 Регистрация: 19.09.2009 Сообщений: 8,808
	24.02.2013, 16:03	17
	Ну я сейчас тогда два варианта программы выложу. Без буфера и с буфером. И можно будет выбрать. 1

@ST2502 0 / 0 / 0 Регистрация: 23.02.2013 Сообщений: 12
	24.02.2013, 17:26 [ТС]	20
	Mawrat, _____ самое то для меня это 3 вариант)))) спасибо огромное-огромное))) Добавлено через 3 минуты Mawrat, можете посмотреть еще эту задачку? она похожая)) мб это через чур))) но все же)) Задача на списки 0

Список слов распечатать в алфавитном порядке. В Turbo Pascal или Pascal ABC

Решение