Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 193
  • Last Modified:

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





0
zattz
Asked:
zattz
3 Solutions
 
Pierre CorneliusCommented:
Probably not the best way, but here's my quick and dirty version:

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: TObject);
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+1];
      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(LongestWord: string);
  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(GetLongestWord(src[0]));
  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
0
 
TNameCommented:
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):TStringList;
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: TObject);
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(SortWords(SLOrig));
        ListBox2.Items.Add('------------');
      end;
    end;
end;


function SortWords(var SL:TStringList):TStringList;
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],Longest) then begin
           Result.Add(SL[i]);
           SL.Delete(i);
           Dec(Len);
           Dec(i);
         end;
         Inc(i);
       end;
     end;
end;


end.
0
 
Tomas Helgi JohannssonCommented:
   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
0
 
mikelittlewoodCommented:
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: TObject);
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: TObject);
begin
  FreeAndNil( slText);
  FreeAndNil( slMax);
end;

end.
0
 
zattzAuthor Commented:
Thanks guys:)
0

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now