Сортировки, Помогите решить задачу Опции

[*alt]

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


С чего начать???
Что сделать???
Как сделать???
Помогите.....

[*alt]

Народ, ну помогите))
с чего начать????

[klem4]

{$B-}

uses crt;

{
  функция сравнения 2-х строк в лексикографическом порядке
}
function CmpStr(const a, b: string): integer;
var
  i, lenA, lenB: byte;

begin
  lenA := length(a);
  lenB := length(b);

  i := 1;
  while (i <= lenA) and (i <= lenB) and (a[i] = b[i]) do
    inc(i);

  if (i > lenA) and (i > lenB) then
    CmpStr := 0
  else if (i > lenA) or ((i <= lenB) and (a[i] < b[i])) then
    CmpStr := -1
  else if (i > lenB) or ((i <= lenA) and (a[i] > b[i])) then
    CmpStr := 1;
end;

type
  { возможные виды морфем: приставка, корень, суффикс, окончание }
  MorphemeType = (
    PREFIX,
    ROOT,
    SUFFIX,
    TERMINATION
  );

  MorphPtr = ^Morpheme;
  
  { структура, хранящая информацию о морфеме в списке морфем }
  Morpheme = record
    _type: MorphemeType; { вид морфемы }
    _value: string;              { значение морфемы }
    next: MorphPtr;            { указатель на следующую морфему в списке }
  end;

  { объект - список морфем, фактически обычный однонаправленный список, вот только элементы 
    добавляются не в начало или конец списка, а добавляются таким образом, чтобы после добавления
    очередного элемента в список, он (список) был упорядочен по полям _value в лексикографическом порядке
  }
  MorphemList = object
    first: MorphPtr; // указатель на первый элемент списка

    constructor Create; // создание пустого списка
    destructor Free; // уничтожение списка

    procedure Add(const mType: MorphemeType; const value: string); {
       добавление морфемы в список (mType - тип морфемы), value - значение
   }
    procedure Print; // печать списка морфем 
  end;

constructor MorphemList .Create;
begin
  first := nil;
end;

destructor MorphemList.Free;
var
  head: MorphPtr;

begin
  while first <> nil do begin
    head := first;
    first := first^.next;
    dispose(head);
  end;
end;

procedure MorphemList.Add(const mType: MorphemeType; const value: string);
var
  p, prev, next: MorphPtr;
  cmp: integer;
begin
  new(p);

  p^._type  := mType;
  p^._value := value;

  if first = nil then begin
    p^.next := nil;
    first := p;
  end else begin

    prev := nil;
    next := first;
    cmp := CmpStr(next^._value, value);

    while (next <> nil) and (cmp < 0) do begin
      prev := next;
      next := next^.next;

      if next <> nil then
        cmp := CmpStr(next^._value, value);
    end;

    if (cmp <> 0) or (mType = ROOT) then begin
      if (prev = nil) then begin
        p^.next := first;
        first := p;
      end else if (next = nil) then begin
        p^.next := nil;
        prev^.next := p
      end else begin
        p^.next := next;
        prev^.next := p;
     end;
    end else dispose(p);

  end;

end;

procedure MorphemList.Print;
var
  p: MorphPtr;
begin
  p := first;
  while p <> nil do begin
    writeln(p^._value);
    p := p^.next;
  end;
end;

{
  в результате работы процедуры, на вход которой поступает строка S вида
  <название_морфемы тип_морфемы>
  будет запись типа_морфемы в переменную mType и самой морфемы в переменную value
}
procedure GetMorphemInfo(const s: string;
                        var mType: MorphemeType;
                        var value: string);
var
  temp: string;
begin
  temp := copy(s, pos(' ', s) + 1, 255);

  if temp = 'ROOT' then
    mType := ROOT
  else if temp = 'PREFIX' then
    mType := PREFIX
  else if temp = 'SUFFIX' then
    mType := SUFFIX
  else mType := TERMINATION;

  value := copy(s, 1, pos(' ', s) - 1);
end;


const
  // символьное отображение названий видов морфем
  // szMotphTypes[PREFIX] == "PREFIX" и т.д.
  szMorphTypes: array [ MorphemeType ] of string =
    ('PREFIX',
     'ROOT',
     'SUFFIX',
     'TERMINATION'
    );

var
  // массив списков морфем, каждый элемент массива - список морфем определенного вида,
  // например mList[ROOT] - список корней
  mList: array [ MorphemeType ] of ^MorphemList;
  mt: MorphemeType; // дополнительная переменная
  morphFile: Text; // текстовый файл с морфемами (пример содержания файла я привел)
  temp, value: string; // дополнительный переменные

begin
  clrscr;

  assign( morphFile, 'c:\morphems.txt' ); 
   reset( morphFIle ); // открываем файл с морфемами для чтения

  for mt := PREFIX to TERMINATION do
    new( mList[ mt ], Create ); // создаем все списки морфем

  while not eof ( morphFile ) do begin // читаем строки из файла
    readln( morphFIle, temp );
    GetMorphemInfo(temp, mt, value); // выдергиваем из строки информацию о морфеме
    mList[mt]^.Add(mt, value); // заносим морфему в соответствующий список
  end;

  for mt := PREFIX to TERMINATION do begin
    writeln( szMorphTypes[ mt ], '''s:'); // подсказка показывает список какой из морфем сейчас будет выведен
    mList[ mt ]^.Print; // печать очередного списка списка
    writeln;
    dispose( mList[ mt ], Free ); // удаление списка
  end;

  close( morphFile ); // не забываем закрыть файл
end.

root1 ROOT
suffix1 SUFFIX
root2 ROOT
termination1 TERMINATION
root3 ROOT
prefix1 PREFIX
termination2 TERMINATION

Сообщение отредактировано: klem4 - 8.05.2008 18:24

[Гость]

klem4, а можно прокомментировать решение, а то я только учусь... не плохо было бы разобраться))))

[klem4]

Хорошо, сегодня добавлю общие комметарии к программе.

[*alt]

Сразу извинюсь, за следующий вопрос.
Но всё же
Что нужно изменить, чтобы программа компилировалась в делфи (консольное приложение)?

[volvo]

Что нужно изменить, чтобы программа компилировалась в делфи (консольное приложение)?

Убрать подключение модуля Crt (вместо него подключаем SysUtils), и убираем вызов ClrScr...

[*alt]

Ну я так и делал, но пишет

[Ïðåäóïðåæäåíèå] sort.dpr(33): Return value of function 'CmpStr' might be undefined

Вот тот же код (на всякий случай)::

Код

program sort;

{$APPTYPE CONSOLE}
uses
  SysUtils,
  windows;

{
  ôóíêöèÿ ñðàâíåíèÿ 2-õ ñòðîê â ëåêñèêîãðàôè÷åñêîì ïîðÿäêå
}
function CmpStr(const a, b: string): integer;
var
  i, lenA, lenB: byte;

begin
  lenA := length(a);
  lenB := length(b);

  i := 1;
  while (i <= lenA) and (i <= lenB) and (a[i] = b[i]) do
    inc(i);

  if (i > lenA) and (i > lenB) then
    CmpStr := 0
  else if (i > lenA) or ((i <= lenB) and (a[i] < b[i])) then
    CmpStr := -1
  else if (i > lenB) or ((i <= lenA) and (a[i] > b[i])) then
    CmpStr := 1;
end;

type
  { âîçìîæíûå âèäû ìîðôåì: ïðèñòàâêà, êîðåíü, ñóôôèêñ, îêîí÷àíèå }
  MorphemeType = (
    PREFIX,
    ROOT,
    SUFFIX,
    TERMINATION
  );

  MorphPtr = ^Morpheme;
  
  { ñòðóêòóðà, õðàíÿùàÿ èíôîðìàöèþ î ìîðôåìå â ñïèñêå ìîðôåì }
  Morpheme = record
    _type: MorphemeType; { âèä ìîðôåìû }
    _value: string;              { çíà÷åíèå ìîðôåìû }
    next: MorphPtr;            { óêàçàòåëü íà ñëåäóþùóþ ìîðôåìó â ñïèñêå }
  end;

  { îáúåêò - ñïèñîê ìîðôåì, ôàêòè÷åñêè îáû÷íûé îäíîíàïðàâëåííûé ñïèñîê, âîò òîëüêî ýëåìåíòû
    äîáàâëÿþòñÿ íå â íà÷àëî èëè êîíåö ñïèñêà, à äîáàâëÿþòñÿ òàêèì îáðàçîì, ÷òîáû ïîñëå äîáàâëåíèÿ
    î÷åðåäíîãî ýëåìåíòà â ñïèñîê, îí (ñïèñîê) áûë óïîðÿäî÷åí ïî ïîëÿì _value â ëåêñèêîãðàôè÷åñêîì ïîðÿäêå
  }
  MorphemList = object
    first: MorphPtr; // óêàçàòåëü íà ïåðâûé ýëåìåíò ñïèñêà

    constructor Create; // ñîçäàíèå ïóñòîãî ñïèñêà
    destructor Free; // óíè÷òîæåíèå ñïèñêà

    procedure Add(const mType: MorphemeType; const value: string); {
       äîáàâëåíèå ìîðôåìû â ñïèñîê (mType - òèï ìîðôåìû), value - çíà÷åíèå
   }
    procedure Print; // ïå÷àòü ñïèñêà ìîðôåì
  end;

constructor MorphemList .Create;
begin
  first := nil;
end;

destructor MorphemList.Free;
var
  head: MorphPtr;

begin
  while first <> nil do begin
    head := first;
    first := first^.next;
    dispose(head);
  end;
end;

procedure MorphemList.Add(const mType: MorphemeType; const value: string);
var
  p, prev, next: MorphPtr;
  cmp: integer;
begin
  new(p);

  p^._type  := mType;
  p^._value := value;

  if first = nil then begin
    p^.next := nil;
    first := p;
  end else begin

    prev := nil;
    next := first;
    cmp := CmpStr(next^._value, value);

    while (next <> nil) and (cmp < 0) do begin
      prev := next;
      next := next^.next;

      if next <> nil then
        cmp := CmpStr(next^._value, value);
    end;

    if (cmp <> 0) or (mType = ROOT) then begin
      if (prev = nil) then begin
        p^.next := first;
        first := p;
      end else if (next = nil) then begin
        p^.next := nil;
        prev^.next := p
      end else begin
        p^.next := next;
        prev^.next := p;
     end;
    end else dispose(p);

  end;

end;

procedure MorphemList.Print;
var
  p: MorphPtr;
begin
  p := first;
  while p <> nil do begin
    writeln(p^._value);
    p := p^.next;
  end;
end;

{
  â ðåçóëüòàòå ðàáîòû ïðîöåäóðû, íà âõîä êîòîðîé ïîñòóïàåò ñòðîêà S âèäà
  <íàçâàíèå_ìîðôåìû òèï_ìîðôåìû>
  áóäåò çàïèñü òèïà_ìîðôåìû â ïåðåìåííóþ mType è ñàìîé ìîðôåìû â ïåðåìåííóþ value
}
procedure GetMorphemInfo(const s: string;
                        var mType: MorphemeType;
                        var value: string);
var
  temp: string;
begin
  temp := copy(s, pos(' ', s) + 1, 255);

  if temp = 'ROOT' then
    mType := ROOT
  else if temp = 'PREFIX' then
    mType := PREFIX
  else if temp = 'SUFFIX' then
    mType := SUFFIX
  else mType := TERMINATION;

  value := copy(s, 1, pos(' ', s) - 1);
end;


const
  // ñèìâîëüíîå îòîáðàæåíèå íàçâàíèé âèäîâ ìîðôåì
  // szMotphTypes[PREFIX] == "PREFIX" è ò.ä.
  szMorphTypes: array [ MorphemeType ] of string =
    ('PREFIX',
     'ROOT',
     'SUFFIX',
     'TERMINATION'
    );

var
  // ìàññèâ ñïèñêîâ ìîðôåì, êàæäûé ýëåìåíò ìàññèâà - ñïèñîê ìîðôåì îïðåäåëåííîãî âèäà,
  // íàïðèìåð mList[ROOT] - ñïèñîê êîðíåé
  mList: array [ MorphemeType ] of ^MorphemList;
  mt: MorphemeType; // äîïîëíèòåëüíàÿ ïåðåìåííàÿ
  morphFile: Text; // òåêñòîâûé ôàéë ñ ìîðôåìàìè (ïðèìåð ñîäåðæàíèÿ ôàéëà ÿ ïðèâåë)
  temp, value: string; // äîïîëíèòåëüíûé ïåðåìåííûå

begin
  {îáðàùåíèå ê ðóññêîìó ÿçûêó}
  setconsoleCp(1251);
  setconsoleOutputCp(1251);

  assign( morphFile, 'morphems.txt' );
   reset( morphFIle ); // îòêðûâàåì ôàéë ñ ìîðôåìàìè äëÿ ÷òåíèÿ

  for mt := PREFIX to TERMINATION do
    new( mList[ mt ], Create ); // ñîçäàåì âñå ñïèñêè ìîðôåì

  while not eof ( morphFile ) do begin // ÷èòàåì ñòðîêè èç ôàéëà
    readln( morphFIle, temp );
    GetMorphemInfo(temp, mt, value); // âûäåðãèâàåì èç ñòðîêè èíôîðìàöèþ î ìîðôåìå
    mList[mt]^.Add(mt, value); // çàíîñèì ìîðôåìó â ñîîòâåòñòâóþùèé ñïèñîê
  end;

  for mt := PREFIX to TERMINATION do begin
    writeln( szMorphTypes[ mt ], '''s:'); // ïîäñêàçêà ïîêàçûâàåò ñïèñîê êàêîé èç ìîðôåì ñåé÷àñ áóäåò âûâåäåí
    mList[ mt ]^.Print; // ïå÷àòü î÷åðåäíîãî ñïèñêà ñïèñêà
    writeln;
    dispose( mList[ mt ], Free ); // óäàëåíèå ñïèñêà
  end;

  close( morphFile ); // íå çàáûâàåì çàêðûòü ôàéë
end.

[volvo]

И что? Warning от Error отличаешь? Оно просто тебя предупреждает, что функция написана так, что МОЖЕТ при каком-то совпадении условий не вернуть значение... Кстати, функция

function f(i: integer): boolean;
begin
  if i > 10 then f := true
  else
    if (i <= 10) then f := false;
  
end;

выдаст точно такое же предупреждение, хотя будет прекрасно работать...

[*alt]

Она компилируется, но сразу же вылетает...
Значит что-то всё-таки не так...

[volvo]

А ты перед последней строкой ReadLn добавить не пробовал? Оно просто отрабатывает, а ты результатов не видишь...

Сообщение отредактировано: volvo - 10.05.2008 15:15

[*alt]

Спасибо, volvo
Всегда readln в конце проверяю, а щас не глянул....

[*alt]

Ещё один вопрос...
Как описать всё то же, но без использования объекта??????

[volvo]

Например вот так:

uses sysutils;

type
  MorphemeType = (
    PREFIX, ROOT, SUFFIX, TERMINATION
  );
const
  szMorphTypes: array [MorphemeType] of string = (
    'PREFIX', 'ROOT', 'SUFFIX', 'TERMINATION'
  );

type
  PTListItem = ^TListItem;
  TListItem = record
    value: string;
    next: PTListItem;
  end;
  TList = record
    first, last: PTListItem;
  end;


procedure CreateList(var L: TList);
begin
  L.first := nil; L.last := nil;
end;
procedure DestroyList(var L: TList);
var T: ptlistitem;
begin
  while L.first <> nil do begin
    T := L.first;
    L.first := L.first^.next;
    dispose(T);
  end;
end;

procedure AppendToList(var L: TList; const value: string);
var p: PTListItem;
begin
  new(p);
  p^.value := value;
  p^.next := nil;

  if L.first = nil then L.first := p
  else L.last^.next := p;

  L.last := p;
end;

function ExistsInList(L: TList; const value: string): boolean;
var p: ptlistitem;
begin
  ExistsInList := true;
  p := L.first;
  while p <> nil do begin
    if p^.value = value then exit;
    p := p^.next;
  end;
  ExistsInList := false;
end;

procedure SortList(var Ls: TList);
  function insert_sort(l: ptlistitem): ptlistitem;

    function insert(a: ptlistitem; l: ptlistitem): ptlistitem;
    begin
      a^.next := nil;
      if l = nil then insert := a
      else
        if a^.value < l^.value then begin
          a^.next := l; insert := a;
        end
        else begin
          l^.next := insert(a, l^.next);
          insert := l;
        end;
    end;

  begin
    if l = nil then insert_sort := nil
    else insert_sort := insert(l, insert_sort(l^.next));
  end;

begin
  Ls.first := insert_sort(Ls.first);
end;

procedure PrintList(var L: TList);
var p: PTListItem;
begin
  SortList(L);

  p := L.first;
  while p <> nil do begin
    writeln(p^.value);
    p := p^.next;
  end;
end;

const
  in_list: array[MorphemeType] of TList = (
    (first:nil; last:nil),
    (first:nil; last:nil),
    (first:nil; last:nil),
    (first:nil; last:nil)
  );


procedure AppendMorph(mt: morphemetype; var value: string);
begin
  if
    ((mt <> ROOT) and (not ExistsInList(in_list[mt], value)))
    or
    (mt = ROOT)
  then begin
    AppendToList(in_list[mt], value);
  end;
end;


function GetMorphemInfo(const s: string;
         var value: string): MorphemeType;
var
  temp: string;
  p: integer;
  mt: morphemetype;
begin
  p := pos(' ', s);
  temp := copy(s, p + 1, 255);
  for mt := low(mt) to high(mt) do begin
    if temp = szMorphTypes[mt] then begin
      GetMorphemInfo := mt;
    end;
  end;
  value := copy(s, 1, p - 1);
end;


var
  morphFile: Text;
  temp, value: string;
  mt: morphemetype;

begin
  assign( morphFile, 'morphems.txt' );
  reset( morphFIle );

  while not eof ( morphFile ) do begin
    readln( morphFIle, temp );
    AppendMorph(GetMorphemInfo(temp, value), value);
  end;

  for mt := low(mt) to high(mt) do begin
    PrintList(in_list[mt]);
    DestroyList(in_list[mt]);
  end;

  close( morphFile );
  readln;
end.

[*alt]

Не работает...
Сначала пишет ошибку::
Constant object cannot be passed as var parameter
здесь

AppendToList(in_list[mt], value);

и здесь

PrintList(in_list[mt]);
DestroyList(in_list[mt]);

После исправления выдаёт чёрный экран.....

[volvo]

*alt, ты мою подпись как следует читал? Перечитай еще раз!

Добавлено через 3 мин.
P.S. Compiler->Options->Assignable typed constants ставишь галочку, или в начале программы {$WRITEABLECONST ON}

[*alt]

volvo, пожалуйста, вы не могли бы написать комментарии к основным блокам программы, чтобы было ясно, что происходит???

[*alt]

volvo, ну напишите, пожалуйста, комментарии...

[volvo]

Комментарии добавлены:
 sorting.pas ( 6.09 килобайт ) Кол-во скачиваний: 435