Задача.
Дан список морфем, в котором указана сама морфема и её тип (приставка, корень, суффикс или окончание). В списке могут встречаться повторяющиеся морфемы.
Написать программу, результатом работы которой должен быть список морфем, разбитый на группы для каждого типа. Внутри этих групп морфемы должны быть упорядочены в лексикографическом порядке. В группе корней одна и таже морфема может встречаться несколько раз, а в других группах морфемы должны быть уникальными.
С чего начать???
Что сделать???
Как сделать???
Помогите.....
Народ, ну помогите))
с чего начать????
{$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.
klem4, а можно прокомментировать решение, а то я только учусь... не плохо было бы разобраться))))
Хорошо, сегодня добавлю общие комметарии к программе.
Сразу извинюсь, за следующий вопрос.
Но всё же
Что нужно изменить, чтобы программа компилировалась в делфи (консольное приложение)?
Ну я так и делал, но пишет
И что? Warning от Error отличаешь? Оно просто тебя предупреждает, что функция написана так, что МОЖЕТ при каком-то совпадении условий не вернуть значение... Кстати, функция
function f(i: integer): boolean;выдаст точно такое же предупреждение, хотя будет прекрасно работать...
begin
if i > 10 then f := true
else
if (i <= 10) then f := false;
end;
Она компилируется, но сразу же вылетает...
Значит что-то всё-таки не так...
А ты перед последней строкой ReadLn добавить не пробовал? Оно просто отрабатывает, а ты результатов не видишь...
Спасибо, volvo
Всегда readln в конце проверяю, а щас не глянул....
Ещё один вопрос...
Как описать всё то же, но без использования объекта??????
Например вот так:
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.
Не работает...
Сначала пишет ошибку::
Constant object cannot be passed as var parameter
здесь
*alt, ты мою подпись как следует читал? Перечитай еще раз!
Добавлено через 3 мин.
P.S. Compiler->Options->Assignable typed constants ставишь галочку, или в начале программы {$WRITEABLECONST ON}
volvo, пожалуйста, вы не могли бы написать комментарии к основным блокам программы, чтобы было ясно, что происходит???
volvo, ну напишите, пожалуйста, комментарии...
Комментарии добавлены:
sorting.pas ( 6.09 килобайт )
Кол-во скачиваний: 564