grouping a list into many lists
I'm looking for some easy code to do the following.
Say I have a list like this:
dog training
dog breeds
dog health
dog food
dog beds
dog training school
the best dog breeds
dog treats
red dog treats
blue dog treats
What I want to do is for each line
(1) Work out which is the longest word
(2) Move all entries from the list that have that longest word in them to another list
until the end of the file...
So I would end up with the following lists:
(1) dog training, dog training school
(2) dog breeds, the best dog breeds
(3) dog health
(4) dog food
(5) dog beds
(6) dog treats, red dog treats, blue dog treats
Say I have a list like this:
dog training
dog breeds
dog health
dog food
dog beds
dog training school
the best dog breeds
dog treats
red dog treats
blue dog treats
What I want to do is for each line
(1) Work out which is the longest word
(2) Move all entries from the list that have that longest word in them to another list
until the end of the file...
So I would end up with the following lists:
(1) dog training, dog training school
(2) dog breeds, the best dog breeds
(3) dog health
(4) dog food
(5) dog beds
(6) dog treats, red dog treats, blue dog treats
Who is Participating?
Hi, here's another version. Put 2 Listboxes and a button on a form:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, SHDocVw, StdCtrls, mshtml, StrUtils;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
SLOrig:TStringList;
public
{ Public declarations }
end;
var
Form1: TForm1;
function SortWords(var SL:TStringList):TStringLis
implementation
{$R *.dfm}
procedure TForm1.FormShow(Sender: TObject);
begin
SlOrig:=TStringList.Create
SlOrig.Add('dog training');
SlOrig.Add('dog breeds');
SlOrig.Add('dog health');
SlOrig.Add('dog food');
SlOrig.Add('dog beds');
SlOrig.Add('dog training school');
SlOrig.Add('the best dog breeds');
SlOrig.Add('dog treats');
SlOrig.Add('red dog treats');
SlOrig.Add('blue dog treats');
ListBox1.Items:=SlOrig;
end;
procedure TForm1.Button1Click(Sender
var
i,len:Integer;
begin
len:=SLOrig.Count;
for i:=0 to SLOrig.Count-1 do begin
if SLOrig.Count> 0 then begin
ListBox2.Items.AddStrings(
ListBox2.Items.Add('------
end;
end;
end;
function SortWords(var SL:TStringList):TStringLis
var
i,j,k,len,Max:Integer;
s,Longest,temp:String;
begin
Result:=nil;
if SL.Count=0 then exit;
Longest:='';
Max:=0;
for i:=0 to SL.Count-1 do begin
s:=Trim(SL[i]);
j:=1;
if Length(s)>0 then
while j<Length(s)+1 do begin
temp:='';
len:=0;
while ((s[j]<>' ') and (j<Length(s)+1)) do begin
temp:=temp+s[j];
inc(len);
Inc(j);
end;
if len>Max then begin
Max:=len;
Longest:=temp;
end;
Inc(j);
end;
end;
if Longest<>'' then begin
Result:=TStringList.Create
len:=SL.Count;
i:=0;
while i<len do begin
if AnsiContainsStr(SL[i],Long
Result.Add(SL[i]);
SL.Delete(i);
Dec(Len);
Dec(i);
end;
Inc(i);
end;
end;
end;
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, SHDocVw, StdCtrls, mshtml, StrUtils;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
SLOrig:TStringList;
public
{ Public declarations }
end;
var
Form1: TForm1;
function SortWords(var SL:TStringList):TStringLis
implementation
{$R *.dfm}
procedure TForm1.FormShow(Sender: TObject);
begin
SlOrig:=TStringList.Create
SlOrig.Add('dog training');
SlOrig.Add('dog breeds');
SlOrig.Add('dog health');
SlOrig.Add('dog food');
SlOrig.Add('dog beds');
SlOrig.Add('dog training school');
SlOrig.Add('the best dog breeds');
SlOrig.Add('dog treats');
SlOrig.Add('red dog treats');
SlOrig.Add('blue dog treats');
ListBox1.Items:=SlOrig;
end;
procedure TForm1.Button1Click(Sender
var
i,len:Integer;
begin
len:=SLOrig.Count;
for i:=0 to SLOrig.Count-1 do begin
if SLOrig.Count> 0 then begin
ListBox2.Items.AddStrings(
ListBox2.Items.Add('------
end;
end;
end;
function SortWords(var SL:TStringList):TStringLis
var
i,j,k,len,Max:Integer;
s,Longest,temp:String;
begin
Result:=nil;
if SL.Count=0 then exit;
Longest:='';
Max:=0;
for i:=0 to SL.Count-1 do begin
s:=Trim(SL[i]);
j:=1;
if Length(s)>0 then
while j<Length(s)+1 do begin
temp:='';
len:=0;
while ((s[j]<>' ') and (j<Length(s)+1)) do begin
temp:=temp+s[j];
inc(len);
Inc(j);
end;
if len>Max then begin
Max:=len;
Longest:=temp;
end;
Inc(j);
end;
end;
if Longest<>'' then begin
Result:=TStringList.Create
len:=SL.Count;
i:=0;
while i<len do begin
if AnsiContainsStr(SL[i],Long
Result.Add(SL[i]);
SL.Delete(i);
Dec(Len);
Dec(i);
end;
Inc(i);
end;
end;
end;
end.
Hi!
What you want to do is use HashMap datastructure which you can get by downloading JEDI Components http://www.delphi-jedi.org/
and use the length of the string as key.
Regards,
Tomas Helgi
What you want to do is use HashMap datastructure which you can get by downloading JEDI Components http://www.delphi-jedi.org/
and use the length of the string as key.
Regards,
Tomas Helgi
And just for the heck of it, here is my little version he he
Got 3 memos on the form for visual and a button for processing
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Memo2: TMemo;
Memo3: TMemo;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
slText, slMax: TStringList;
procedure GroupSentences;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
slText := TStringList.Create;
slMax := TStringList.Create;
end;
procedure TForm1.Button1Click(Sender
var
i, j, k: Integer;
slTemp: TStringList;
begin
slMax.Clear;
slText.Text := Memo1.Text;
slTemp := TStringList.Create;
try
for i := 0 to slText.Count - 1 do
begin
slTemp.Clear;
slTemp.Delimiter := ' ';
slTemp.DelimitedText := slText.Strings[ i];
for j := 0 to slTemp.Count - 1 do
if slMax.IndexOf( Trim( slTemp.Strings[ j])) = -1 then
begin
if slMax.Count = 0 then
slMax.Add( Trim( slTemp.Strings[ j]) )
else
for k := 0 to slMax.Count - 1 do
if Length( slTemp.Strings[ j]) >= Length( slMax.Strings[ k]) then
begin
slMax.Insert( k, Trim( slTemp.Strings[ j]));
Break;
end
else
if k = slMax.Count - 1 then
slMax.Add( Trim( slTemp.Strings[ j]) );
end;
end;
finally
FreeAndNil( slTemp);
end;
Memo2.Text := slMax.Text;
GroupSentences;
end;
procedure TForm1.GroupSentences;
var
i, j: Integer;
sText: string;
begin
for i := 0 to slMax.Count - 1 do
begin
sText := '';
for j := slText.Count - 1 downto 0 do
begin
if Pos( slMax.Strings[ i], slText.Strings[ j]) > 0 then
begin
if sText <> '' then
sText := sText + ', ' + slText.Strings[ j]
else
sText := slText.Strings[ j];
slText.Delete( j);
end;
end;
if sText <> '' then
Memo3.Lines.Add( sText);
end;
end;
procedure TForm1.FormDestroy(Sender:
begin
FreeAndNil( slText);
FreeAndNil( slMax);
end;
end.
Got 3 memos on the form for visual and a button for processing
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Memo2: TMemo;
Memo3: TMemo;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
slText, slMax: TStringList;
procedure GroupSentences;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
slText := TStringList.Create;
slMax := TStringList.Create;
end;
procedure TForm1.Button1Click(Sender
var
i, j, k: Integer;
slTemp: TStringList;
begin
slMax.Clear;
slText.Text := Memo1.Text;
slTemp := TStringList.Create;
try
for i := 0 to slText.Count - 1 do
begin
slTemp.Clear;
slTemp.Delimiter := ' ';
slTemp.DelimitedText := slText.Strings[ i];
for j := 0 to slTemp.Count - 1 do
if slMax.IndexOf( Trim( slTemp.Strings[ j])) = -1 then
begin
if slMax.Count = 0 then
slMax.Add( Trim( slTemp.Strings[ j]) )
else
for k := 0 to slMax.Count - 1 do
if Length( slTemp.Strings[ j]) >= Length( slMax.Strings[ k]) then
begin
slMax.Insert( k, Trim( slTemp.Strings[ j]));
Break;
end
else
if k = slMax.Count - 1 then
slMax.Add( Trim( slTemp.Strings[ j]) );
end;
end;
finally
FreeAndNil( slTemp);
end;
Memo2.Text := slMax.Text;
GroupSentences;
end;
procedure TForm1.GroupSentences;
var
i, j: Integer;
sText: string;
begin
for i := 0 to slMax.Count - 1 do
begin
sText := '';
for j := slText.Count - 1 downto 0 do
begin
if Pos( slMax.Strings[ i], slText.Strings[ j]) > 0 then
begin
if sText <> '' then
sText := sText + ', ' + slText.Strings[ j]
else
sText := slText.Strings[ j];
slText.Delete( j);
end;
end;
if sText <> '' then
Memo3.Lines.Add( sText);
end;
end;
procedure TForm1.FormDestroy(Sender:
begin
FreeAndNil( slText);
FreeAndNil( slMax);
end;
end.
Question has a verified solution.
Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.
Have a better answer? Share it in a comment.
All Courses
From novice to tech pro — start learning today.
-
Course of the Month8 days, 6 hours left to enrollMonitoring and Operating a Private Cloud with System Center 2012 R2 273 lessons
PAS File
==========================
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
ListBox2: TListBox;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
uses StrUtils;
{$R *.dfm}
function SortByStringLength(List: TStringList; Index1, Index2: Integer): Integer;
begin
result:= length(List[Index1]) - Length(List[Index1]);
end;
procedure TForm1.Button1Click(Sender
var src, dest: TStringList;
function GetLongestWord(s: string): string;
const WordDelimiters: set of char = [' ', ',', '.'];
var words: array of string;
i: integer;
begin
result:= '';
SetLength(words, length(words)+1);
try
for i:= 0 to length(s)-1 do
begin
if s[i+1] in WordDelimiters
then SetLength(words, length(words)+1)
else words[length(words)-1]:= words[length(words)-1]+s[i
end;
for i:= low(words) to High(words) do
if Length(result) < Length(words[i])
then result:= words[i];
finally
SetLength(words, 0);
end;
end;
procedure MoveBasedOnLongestWord(Lon
var i: integer;
s: string;
begin
s:= '';
for i:= src.Count-1 downto 0 do
if Pos(LongestWord, Src[i]) <> 0 then
begin
s:= s + Src[i]+', ';
Src.delete(i);
end;
if s <> '' then
begin
SetLength(s, length(s)-2); //remove last comma space pair
ListBox2.Items.Add(s);
end;
end;
begin
ListBox2.Clear;
src:= TStringList.Create;
try
src.Assign(ListBox1.Items)
while src.Count > 0
do MoveBasedOnLongestWord(Get
finally
src.Free;
end;
end;
end.
DFM File
==========================
object Form1: TForm1
Left = 192
Top = 114
Width = 551
Height = 338
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object ListBox1: TListBox
Left = 16
Top = 24
Width = 121
Height = 257
ItemHeight = 13
Items.Strings = (
'dog training'
'dog breeds'
'dog health'
'dog food'
'dog beds'
'dog training school'
'the best dog breeds'
'dog treats'
'red dog treats'
'blue dog treats')
TabOrder = 0
end
object Button1: TButton
Left = 168
Top = 32
Width = 75
Height = 49
Caption = 'Sort by length and move'
TabOrder = 1
WordWrap = True
OnClick = Button1Click
end
object ListBox2: TListBox
Left = 280
Top = 24
Width = 241
Height = 257
ItemHeight = 13
TabOrder = 2
end
end
Kind regards
Pierre