Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

grouping a list into many lists

Posted on 2006-11-21
5
Medium Priority
?
191 Views
Last Modified: 2010-04-05
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
Comment
Question by:zattz
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
5 Comments
 
LVL 14

Accepted Solution

by:
Pierre Cornelius earned 800 total points
ID: 17986604
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
 
LVL 28

Assisted Solution

by:TName
TName earned 600 total points
ID: 17986664
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
 
LVL 25

Expert Comment

by:Tomas Helgi Johannsson
ID: 17986668
   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
 
LVL 15

Assisted Solution

by:mikelittlewood
mikelittlewood earned 600 total points
ID: 17986802
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
 

Author Comment

by:zattz
ID: 17993351
Thanks guys:)
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
In response to a need for security and privacy, and to continue fostering an environment members can turn to for support, solutions, and education, Experts Exchange has created anonymous question capabilities. This new feature is available to our Pr…
Are you ready to place your question in front of subject-matter experts for more timely responses? With the release of Priority Question, Premium Members, Team Accounts and Qualified Experts can now identify the emergent level of their issue, signal…
Suggested Courses

618 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question