Solved

grouping a list into many lists

Posted on 2006-11-21
5
166 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
5 Comments
 
LVL 14

Accepted Solution

by:
Pierre Cornelius earned 200 total points
Comment Utility
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 150 total points
Comment Utility
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 24

Expert Comment

by:Tomas Helgi Johannsson
Comment Utility
   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 150 total points
Comment Utility
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
Comment Utility
Thanks guys:)
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Suggested Solutions

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…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

744 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

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now