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

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

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

 
 Ответить  Открыть новую тему 
> Сортировки, Помогите решить задачу
сообщение
Сообщение #1


Новичок
*

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

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


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


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


Новичок
*

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

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


Народ, ну помогите))
с чего начать????
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

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


{$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.


Цитата(morphems.txt)
root1 ROOT
suffix1 SUFFIX
root2 ROOT
termination1 TERMINATION
root3 ROOT
prefix1 PREFIX
termination2 TERMINATION


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


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






klem4, а можно прокомментировать решение, а то я только учусь... не плохо было бы разобраться))))
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

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


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


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

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

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


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

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






Цитата
Что нужно изменить, чтобы программа компилировалась в делфи (консольное приложение)?
Убрать подключение модуля Crt (вместо него подключаем SysUtils), и убираем вызов ClrScr...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Новичок
*

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

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


Ну я так и делал, но пишет
Цитата
[Ïðåäóïðåæäåíèå] 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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гость






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

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

end;

выдаст точно такое же предупреждение, хотя будет прекрасно работать...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Новичок
*

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

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


Она компилируется, но сразу же вылетает...
Значит что-то всё-таки не так...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Гость






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

Сообщение отредактировано: volvo -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Новичок
*

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

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


Спасибо, volvo
Всегда readln в конце проверяю, а щас не глянул....
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Новичок
*

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

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


Ещё один вопрос...
Как описать всё то же, но без использования объекта??????
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






Например вот так:
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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Новичок
*

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

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


Не работает...
Сначала пишет ошибку::
Constant object cannot be passed as var parameter
здесь
Цитата
AppendToList(in_list[mt], value);

и здесь
Цитата

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


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

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Гость






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

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


Новичок
*

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

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


volvo, пожалуйста, вы не могли бы написать комментарии к основным блокам программы, чтобы было ясно, что происходит???
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Новичок
*

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

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


volvo, ну напишите, пожалуйста, комментарии...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Гость






Комментарии добавлены:
Прикрепленный файл  sorting.pas ( 6.09 килобайт ) Кол-во скачиваний: 437
 К началу страницы 
+ Ответить 

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

 





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