|
|
|
|
|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
 |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
14.06.2012, 17:37
|
|||
|
|||
Cравнение TStringList
 Вообщем суть в том что есть два списка слов. оба упорядочены. 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; |
|
#3
14.06.2012, 17:50
|
||||
|
||||
Во-первых, Delete уменьшает верхнюю границу цикла, в то время как в FOR-цикле она фиксирована (считается один раз в начале цикла). Будет выход за границы списка.
Во-вторых, раз и так проходит цикл по всем элементам списка allwords, то зачем каждый раз вызывать медленную функцию IndexOf? Проще сравнивать words[i] и allwords[j]. На относительно небольших списках это будет быстрее, чем постоянное освобождение памяти и перестройка списка. На больших - не знаю, надо думать. И в-третьих, почему IndexOf>0? Ошибка выдает -1, а 0 - вполне себе валидный индекс: Цитата:
Последний раз редактировалось Bargest, 14.06.2012 в 17:56. |
|
#4
14.06.2012, 17:54
|
|||
|
|||
|
был вариант
Код:
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 раза. =/ |
|
#6
14.06.2012, 18:01
|
|||
|
|||
|
Сейчас выявил проблему.
Код:
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. |
|
#8
14.06.2012, 18:09
|
|||
|
|||
|
Цитата:
Каждое слово в списке уже 1 раз в тексте встречается точно. В принципе выставив тут 0 я получу вместо 2 2 2. 1 1 1 |
| Этот пользователь сказал Спасибо Bargest за это полезное сообщение: | ||
rerebro (14.06.2012)
| ||
|
#10
14.06.2012, 18:16
|
|||
|
|||
|
Цитата:
оставил только Код:
allwords:=TStringList.Create; words:= TStringList.Create; Embarcadero® Delphi® XE2 Version 16.0.4276.44006 воспринимает сортировку еще как и игнорирование дупликатов. В следствии чего я сравнивал 2 одинаковых списка. Но это в теори. Сейчас потестим. |
|
#11
14.06.2012, 18:20
|
|||
|
|||
|
Вообщем
words.Duplicates:=dupIgnore; не работает совершенно. в поле мемо вывело весь список слов. Но сравнил он правильно почему то Код:
5 слов только 1 работало 1 чтобы И по моему та проблема из за которой я сижу уже 3 часа. В убогости компилятора.=/ Но теперь мне в фаил выводится все слова. Буду думать как убрать дубликаты. Последний раз редактировалось rerebro, 14.06.2012 в 18:23. |
|
#12
14.06.2012, 19:23
|
|||
|
|||
|
Код:
procedure let(var hash: TStringList; key, value: string);
var s: string;
begin
if hash.Values[key] <> '' then
hash.Delete(hash.IndexOf(Format('%s=%s', [key, hash.Values[key]])));
hash.Add(Format('%s=%s', [key, value]));
end;
procedure add(var hash: TStringList; key: string);
begin
if hash.Values[key] = '' then
let(hash, key, '1')
else
let(hash, key, IntToStr(StrToInt(hash.values[key])+1))
end;
procedure TForm1.Button1Click(Sender: TObject);
var arr: array[0..5] of string;
var hash: TStringList;
var i: integer;
var s: string;
begin
arr[0] := 'a';
arr[1] := 'b';
arr[2] := 'c';
arr[3] := 'a';
arr[4] := 'a';
arr[5] := 'b';
hash := TStringList.Create; hash.Sorted := true;
for i := 0 to high(arr) do add(hash, arr[i]);
Memo1.Lines.Assign(hash);
end;зы те 2 процедуры костыля можно убрать, если использовать модуль отсюда http://www.delphipages.com/forum/showthread.php?t=26334 Последний раз редактировалось Pyro, 14.06.2012 в 19:34. |
|
#13
14.06.2012, 19:49
|
|||
|
|||
|
Такие программы надо писать, думая сперва головой.
Зачем составлять 2 списка? Все это делается в 1 проход. Код:
var
arr: array[0..5] of string;
L : TStringList;
I, Idx : Integer;
begin
arr[0] := 'a';
arr[1] := 'b';
arr[2] := 'c';
arr[3] := 'a';
arr[4] := 'a';
arr[5] := 'b';
L := TStringList.Create;
For I := 0 To 5 Do
Begin
Idx := IndexOf(arr[i]);
If Idx >= 0
Then L.Objects[Idx] := TObject(Integer(L.Objects[Idx]) + 1)
Else L.AddObject(arr[i],TObject(1));
End;
For I := 0 To L.Count-1 Do
WriteLn(L[i],' -> ',Integer(L.Objects[i]));
L.Free;Как-то так. |
Линейный вид
