Списки + строки.

[Chudo4258]

Дана непустая последовательность слов, в каждом из которых от 1 до 12 букв, между словами пробел, за последним словом точка.Напечатать эти слова по алфавиту, указав для каждого из них число его вхождений в эту последовательность.

Решать обязательно с использованием списков.
Т.е. сначала все слова переписать в список -> вывести список -> отсортировать список-> вывести список.

Я завис на том, как переписать слова в список, что-то процедура не хочеть работать.

Type BT = string;
     U = ^Zveno;
     Zveno = Record
        Inf : BT;
        kol:integer;  //кол-во вхождений слова в список
        Next: U
     End;

Procedure V_Spisok(Pred : U; X : BT);
       Var Vsp : U;
       Begin
           New(Vsp);
           Vsp^.Inf := X;
           Vsp^.Next := Pred^.Next;
           Pred^.Next := Vsp;
       End;

Procedure Spisok(var S:U);
var S_,S1:U;
    str,slov:BT;
    i:integer;

Begin
    write('Stroka:  '); readln(str);
    slov:='';
    S:=nil;
    S1:=S;
    S_:=S;
    for i:=1 to length(str) do
     begin
      if (str[i]=' ')or(str[i]='.')or(str[i]=',')
          then begin
                 S1:=S;
                 while S1<>nil do begin
                   if S1^.Inf=slov then inc(S1^.kol)
                                   else begin
                                          V_Spisok(S_,slov);
                                          S_^.kol:=1;
                                          S_:=S_^.Next;
                                          slov:=''
                                         end;
                   S1:=S1^.Next; end;
                end
          else slov:=slov+str[i];
end;
End;

Procedure Print(First : U);
       Var Vsp : U;
       Begin
            Vsp := First;
            While Vsp <> Nil Do
            Begin
               Write(Vsp^.Inf);
               Vsp := Vsp^.Next
            End; WriteLn
       End;

From Stilet: Да чтож ты нетерпеливый то такой, мож когда ты постил сообщение народ то спал.

[Stilet]

Мож не в тему, но тут пример остался, как с динамиксписками работать, правда неконсольный но принципы те же.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;

type
// Определяем тип записи с полями
TZapis=Record

   // Указатель на предидущую запись
   Predidushaya_zapis:pointer;

   // название книги,автор,
   //год издание, число страниц,количество экземпляров.
   name,avtor:string[255];
   god,chis_str,chis_akz:integer;
   // Указатель на следующую запись
   Sleduyushaya_zapis:pointer;
  end;
//**************************************************************************
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    StringGrid1: TStringGrid;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var     CurrentRecord:pointer;
//
        fz,Zapis:^TZapis;
  Form1: TForm1;

implementation

{$R *.dfm}


// Кнопка Добавить запись
procedure TForm1.Button1Click(Sender: TObject);

begin
// Если запись пустая то на нее не переходить
if Zapis<>nil then CurrentRecord:=Zapis;

// Создадим новую запись
new(zapis);
if CurrentRecord<>nil then
 tzapis(CurrentRecord^).Sleduyushaya_zapis:=zapis;
if fz=nil then fz:=zapis;
// Предидущую запись запомним для этой
Zapis.Predidushaya_zapis:=CurrentRecord;
// Это заполнение полей
Zapis.name:=Edit1.Text;
Zapis.avtor:=Edit2.Text;
Zapis.god:=strtoint(Edit3.Text);
Zapis.chis_akz:=strtoint(Edit4.Text);
Zapis.chis_str:=strtoint(Edit5.Text);
Zapis.chis_akz:=strtoint(Edit6.Text);
// теперь в предидущей записи
// запомним вновь созданную

end;


// Кнопка показать следующую запись
procedure TForm1.Button2Click(Sender: TObject);
begin
//if CurrentRecord<>nil then
if Tzapis(CurrentRecord^).Sleduyushaya_zapis<>nil then begin
 CurrentRecord:=Tzapis(CurrentRecord^).Sleduyushaya_zapis;
 Edit1.Text:=Tzapis(CurrentRecord^).name;
end;{}
end;


// Кнопка Показать предидушую запись
procedure TForm1.Button3Click(Sender: TObject);
begin
 if Tzapis(CurrentRecord^).Predidushaya_zapis<>nil then begin
 CurrentRecord:=Tzapis(CurrentRecord^).Predidushaya_zapis;
 Edit1.Text:=Tzapis(CurrentRecord^).name;
end;{}
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
// Определяем начальное колво записей в таблице
StringGrid1.RowCount:=2;
//Прыгаем на первую запись
CurrentRecord:=fz;
// И до последней записи делаем :
 while CurrentRecord<>nil do begin
 // Здесь присваиваем последней строке таблицы текущую запись
  StringGrid1.Cells[0,StringGrid1.RowCount-1]:=Tzapis(CurrentRecord^).name;
 // Добавляем еще одну строку внизу
  StringGrid1.RowCount:=StringGrid1.RowCount+1;
 // И прыгаем на следующую запись
  CurrentRecord:=Tzapis(CurrentRecord^).Sleduyushaya_zapis;
 end;
end;

end.

Тебе его подчистить (Write, Read) прикрепить, ну и сортировку сделать.

Насчет получения слова из строки:

s:=s+' ';
i:=pos(' ',S);
while i<>0 do begin
 ss:=copy(s,1,i); // Получили очередное слово
 delete(s,1,i);
 i:=pos(' ',S);
end;

[Chudo4258]

С заполнением списка разобрался. Спасибо.
Но вот еще такой вопросик, как отсортировать слова в алфавитном порядке???

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

Причем извесно что слова не длиннее 12 символов.

[Chudo4258]

Все решил. Всем спасибо!!!

Задача: Дана непустая последовательность слов, в каждом из которых от 1 до 12 букв, между словами пробел, за последним словом точка.Напечатать эти слова по алфавиту, указав для каждого из них число его вхождений в эту последовательность.

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

Type BT = string;
     U = ^Zveno;
     Zveno = Record
        Inf : BT;
        kol:integer;
        Next: U
     End;

Procedure V_Nachalo(Var First : U; X : BT);
       Var Vsp : U;
       Begin
               New(Vsp);
               Vsp^.Inf := X;
               Vsp^.Next := First;
               First := Vsp;
       End;

Procedure V_Spisok(Pred : U; X : BT);
       Var Vsp : U;
       Begin
           New(Vsp);
           Vsp^.Inf := X;
           Vsp^.Next := Pred^.Next;
           Pred^.Next := Vsp;
       End;

Procedure Vh(S:U; st:string; var vsp:U; var p:boolean);
var v:U;
    i:integer;
begin
 v:=S;
 i:=0;
 p:=false;
 while v<>nil do
  begin
   if v^.Inf=st then begin vsp:=v; inc(i); p:=true; end;;
   v:=v^.Next;
  end;
end;

Procedure Formirov_Spiska(var v:U);
var dx,vsp:U;
    p:boolean;
    i:integer;
    st,ss:BT;
begin
   Write('vvedite predlozhenie: ');
   readln(st);
st:=st+' ';
i:=pos(' ',st);
while i<>0 do
begin
 ss:=copy(st,1,i); // Получили очередное слово
 delete(st,1,i);
 If v = Nil
             Then Begin
                     V_Nachalo(v, ss);
                     v^.kol:=1;
                     dx := v
                  End
             Else Begin
                    Vh(v,ss,vsp,p);
                    if p then inc(vsp^.kol)
                         else begin
                    V_Spisok(dx, ss);
                    dx:=dx^.Next;
                    dx^.kol:=1; end;
                  end;
 i:=pos(' ',st);
end;
end;
Procedure Print(First : U);
       Var Vsp : U;
       Begin
           if First=nil then Writeln('Spisok pustoy!!!')
                        else begin writeln;Writeln('Spisok:');
            Vsp := First;
            While Vsp <> Nil Do
            Begin
               Write(Vsp^.Inf,'-',vsp^.kol,';  ');
               Vsp := Vsp^.Next
            End; writeln;end;
       End;
{Сортировка массива выбором (в порядке возрастания).
 Идея решения: пусть часть массива (по K-й элемент включительно)
 отсортирована. Нужно найти в неотсортированной части массива
 минимальный элемент и поменять местами с (K+1)-м}
Procedure Sortirovka(var S:U);
var vsp1,vsp2,K:U;
    st:string;
    kol:integer;
begin
vsp1:=S;
while vsp1<>nil do
begin
 K:=vsp1;
 vsp2:=vsp1^.Next;
 while vsp2<>nil do begin
   if vsp2^.Inf<K^.Inf then K:=vsp2;
   vsp2:=vsp2^.Next; end;
 st:=vsp1^.Inf;
 kol:=vsp1^.kol;
 vsp1^.Inf:=K^.Inf;
 vsp1^.kol:=K^.kol;
 K^.Inf:=st;
 K^.kol:=kol;
 vsp1:=vsp1^.Next;
end;
end;
var S:U;

begin
  { TODO -oUser -cConsole Main : Insert code here }
Formirov_Spiska(S);
Print(S);
Sortirovka(S);
writeln;
Print(S);
readln
end.