[rerebro]

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

Код:

 words:= TStringList.Create;
     words.Sorted:=True;
     words.Duplicates:=dupIgnore;
     allwords:=TStringList.Create;
     allwords.Sorted:=True;

Нужен цикл или способ. Сравнить эти 2 списка и записать количество повторений для каждого слова. Пробывал по разному написать почему то цикл проходит 1 раз. и выводит на все слова 2.
последняя не правильно работающая попытка. =\

Код:

  for i := 0 to words.Count-1 do
      for j := 0 to allwords.Count-1 do
          if allwords.indexOf(words[i])>0 then
          begin
          allwords.Delete(allwords.indexOf(words[i]));
        inc(snum[i]);
        end;

[rerebro]

Все списки 100% заполнены. и спокойно выводятся в файл. Проблема в подсчете Абсолютной частоты появления в нем. =\

[Bargest]

Во-первых, Delete уменьшает верхнюю границу цикла, в то время как в FOR-цикле она фиксирована (считается один раз в начале цикла). Будет выход за границы списка.
Во-вторых, раз и так проходит цикл по всем элементам списка allwords, то зачем каждый раз вызывать медленную функцию IndexOf? Проще сравнивать words[i] и allwords[j]. На относительно небольших списках это будет быстрее, чем постоянное освобождение памяти и перестройка списка. На больших - не знаю, надо думать.
И в-третьих, почему IndexOf>0? Ошибка выдает -1, а 0 - вполне себе валидный индекс:

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

Note that IndexOf returns the 0-based index of the string. Thus, if S matches the first string in the list, IndexOf returns 0, if S is the second string, IndexOf returns 1, and so on. If the string does not have a match in the string list, IndexOf returns -1.

[rerebro]

был вариант

Код:

 for i := 0 to words.Count-1 do
      for j := 0 to allwords.Count-1 do
          if allwords[j]=words[i] then
          begin
           inc(snum[i]);
        end;

самый обычный. вообшем на файле:

Код:

Только только только чтобы работало  только только   только только   только только   только только   только только 

Созданым для проверки. выходит

Код:

words:
работало
только
чтобы

при проверке статистики пишет что все встречаются по 2 раза. =/

[Bargest]

Выложи весь код. По циклу вроде все верно. Ошибка может быть до или после.

[rerebro]

Сейчас выявил проблему.

Код:

words:= TStringList.Create;
    words.Sorted:=True;
    words.Duplicates:=dupIgnore;
    allwords:=TStringList.Create;
    allwords.Sorted:=True;

убирая эту строку. или при отправки из allwords в поле мемо выводится все тот же список из трех слов.

Код:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons;

type
  TForm1 = class(TForm)
    Label2: TLabel;
    BitBtn1: TBitBtn;
    Opens: TBitBtn;
    BitBtn3: TBitBtn;
    Label3: TLabel;
    Label4: TLabel;
    Edit1: TEdit;
    Label5: TLabel;
    BitBtn4: TBitBtn;
    Label7: TLabel;
    Label9: TLabel;
    Label8: TLabel;
    Label10: TLabel;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Memo1: TMemo;
    Memo2: TMemo;
    Label6: TLabel;
    Label11: TLabel;
    BitBtn2: TBitBtn;
    Edit2: TEdit;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label1: TLabel;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure opensClick(Sender: TObject);
    procedure savesClick(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);



  private
   a: array of WideString;
   stroki: array of string;
    num: array of integer;
    snum: array of integer;
    ss,ssw: integer;
    words, allwords: TStringList;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

 procedure SplitTextIntoWords(const str: string;
output: Tstringlist; minLength: integer=1);
var
  pS, pE: integer;
  wordToAdd: string;
begin
  Assert(Assigned(output));
  output.Clear;
  ps := 1;
  while ps <= Length(str) do
  begin
    while (ps <= Length(str)) and not IsCharAlpha(str[ps]) do
      Inc(ps);
    if ps <= Length(str) then
    begin
      pe := ps + 1;
      while (pe <= Length(str)) and IsCharAlpha(str[pe]) do
        Inc(pe);
      wordToAdd := Copy(str, ps, pe - ps);
      if (Length(wordToAdd) >= minLength) then
      begin
        // добавление слова в список
        output.Add(AnsiLowerCase(wordToAdd));
      end;
      ps := pe + 1;
    end;
  end;
end;



 procedure TForm1.opensClick(Sender: TObject);
var
  f1: TextFile;
  i,j,index:integer;
  o: string;
  l,slc: char;
  t,m: boolean;
  ww:string;
  //words: TStringList;

begin



   if OpenDialog1.Execute then
   begin
     o:=OpenDialog1.FileName;
     AssignFile(f1,o);
     Reset(f1);
     ss:=0;


     memo1.lines.loadfromfile(o);
     words:= TStringList.Create;
     words.Sorted:=True;
     allwords:=TStringList.Create;
     allwords.Sorted:=True;
  SplitTextIntoWords(memo1.text,allwords);
  SplitTextIntoWords(memo1.text,words);
  Memo2.Text:=allwords.Text;
  ssw:=allwords.count-1;
  Label11.Caption:=inttostr(allwords.Count);
  setLength(snum, words.Count);
  for i := 0 to words.Count-1 do
    snum[i]:=1;
  //snum[1]:=1;


      for i := 0 to words.Count-1 do
      for j := 0 to allwords.Count-1 do
          if allwords[j]=words[i] then
          begin
           inc(snum[i]);
        end;
   { if not m then
    begin
          SetLength(snum, Length(snum)+1);
          snum[high(snum)]:=1;
    end;}




  while not EOF(f1) do
    begin
       t:=false;
       read(f1, l);
       if (l<>' ') then // and (l<>',') and (l<>'.') then
           Inc(ss)
           else
           if (l=' ') then //xor (l=',') xor (l='.') then
              inc(ss);

       for i:=Low(a) to High(a) do
         if a[i]=(l) then
         begin
           Inc(num[i]);
           t:=true;
         end;
         if not t then
         begin
           SetLength(a, Length(a)+1);
           SetLength(num, Length(num)+1);
           a[High(a)]:=(l);
           num[High(num)]:=1;
         end;
     end;
   end;


 {  for I := 0 to words.count-1 do
   begin
       ww:= words[i];
       for j := 0 to words.Count-1 do
            if ww[i]=words[j] then
            begin
             inc(snum[i]);
             words.
            end
          else
          begin
              for j := 0 to words.Count-1 do
          begin
            if ww=words[j] then
            begin
             inc(snum[i]);
            end;
          end;
         SetLength(stroki, Length(stroki)+1);
         SetLength(snum, Length(snum)+1);
         a[High(a)]:=(l);
           num[High(num)]:=1;
        end;
     end;
  end; }





   Label1.Caption:=('Открыт фаил: '+ OpenDialog1.FileName);
   Label4.caption:=inttostr(ss);
   Label2.Visible:= true;
   Label3.Visible:= true;
   Label4.Visible:= true;
   BitBtn4.Visible:=true;
   BitBtn3.Visible:=true;
   Label5.Visible:= true;
   Label7.Visible:= true;
   Label8.Visible:= true;
   Label9.Visible:= true;
   Label10.Visible:= true;
   Edit1.visible:=true;
CloseFile(f1);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
   Form1.Close;
   words.Free;
   allwords.Free;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var vb,d:string;
    i:integer;
    eg:real;
begin

   vb:=Edit2.Text;

  for i:=0 to words.Count-1 do
     begin
       if vb=(words[i])then
        begin
          eg:=snum[i]/ssw;
          str(eg:0:6,d);
          Label14.caption:= inttostr(snum[i]);
          label12.caption:=d;
        end;
     end;
end;



procedure TForm1.BitBtn4Click(Sender: TObject);
var vb,d:string;
    i:integer;
    eg:real;
begin

   vb:=Edit1.Text;

  for i:=Low(a) to High(a) do
     begin
       if vb=(a[i])then
        begin
          eg:=num[i]/ss;
          str(eg:0:6,d);
          Label9.caption:= inttostr(num[i]);
          label10.caption:=d;
        end;
     end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
      Label2.Visible:= false;
     Label3.Visible:= false;
     Label4.Visible:= false;
     Label5.Visible:= false;
     Label7.Visible:= false;
     Label8.Visible:= false;
     Label9.Visible:= false;
     Label10.Visible:= false;
     BitBtn4.Visible:=false;
     BitBtn3.Visible:=false;

     Edit1.visible:=false;

end;



procedure TForm1.savesClick(Sender: TObject);
var
  f2: TextFile;
  s: string;
  i,j: integer;
begin
   if SaveDialog1.Execute then
   begin
     s:=SaveDialog1.FileName;
     AssignFile(f2,s);
     Rewrite(f2);
     writeln(f2,'Symb in file = ',ss);
     writeln(f2,'Symb     Abs    Otn');
     for i:=low(a) to high(a) do    //for i:=low(a) to High(a) do
     begin
       writeln(f2, '"', a[i], '"      ', num[i], '     ', num[i]/ss);
     end;
      for j:=0 to words.Count-1 do    //for i:=low(a) to High(a) do
     begin
       writeln(f2, '"', words[j], '"      ', snum[j], '     ', snum[j]/ssw);
     end;

   end;
    Label2.Caption:=('Сохраненный фаил: '+ SaveDialog1.FileName);
   CloseFile(f2);
end;



end.