Solved

Remove all sentences shorter than X words

Posted on 2006-11-24
9
363 Views
Last Modified: 2010-04-05
Hi

I'm looking for some code that will remove all sentences shorter than X words from a memo.

Thanks
0
Comment
Question by:zattz
9 Comments
 
LVL 16

Expert Comment

by:CodedK
ID: 18010972
Hi zattz i've made a demo for you here :
http://www.geocities.com/kalatz_gr_fisher/TheFiles/Censor.zip

Didnt test it thoroughly... Its just to give you an idea :)

Hope this helps.
0
 

Author Comment

by:zattz
ID: 18011000
Hi,

I'm not sure what your demo is doing, but it's not removing the sentences shorter than X words.

Top memo:
This sentence has five words. This sentence has six six words.  This has three.  This has four words.

Press button.

Bottom memo:
 entence entence words. three.


0
 
LVL 16

Expert Comment

by:CodedK
ID: 18011006
The top is the original text, bottom is the one with the words smaller than x removed and the left is
just a refference of what has been deleted.

I pasted this at the top text :
------------------------------------------------------
I'm looking for some code that will remove all sentences shorter than X words from a memo.
------------------------------------------------------


and wrote to cut everything smaller than 5... Result :
------------------------------------------------------
 looking remove sentences shorter
------------------------------------------------------
0
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
LVL 16

Expert Comment

by:CodedK
ID: 18011017
Sorry zattz...
I just saw sentences not words... sorry i misread your question...
0
 
LVL 15

Accepted Solution

by:
mikelittlewood earned 250 total points
ID: 18011036
This assumes every sentence finishes with a full stop (.) and words separated with a space ( ).
Not tested but you should get the idea.

function removeSentences( sentences: String; TotWords: Integer): String;
var
  sl: TStringList;
  i: Integer;
begin
  sl := TStringList.Create;
  try
    sl.Delimiter := '.';
    sl.Delimitedtext := sentences;

    for i := sl.Count - 1 downto 0 do
      if CountWords( sl.Strings[ i]) < TotWords then
        sl.Delete( i);
  finally
    FreeAndNil( sl)
  end;
  Result := sl.text;
end;

function countWords( sentence: String; TotWords: Integer): Boolean;
var
  s: String;
  i: Integer;
begin
  i := 0;
  while Pos( ' ', sentence) > 0 do
  begin
     Inc( i);
     sentence := Copy( sentence, Pos( ' ', sentence) + 1, MAXINT);
  end;
  // last word no space but full stop so add 1 to total
  Result := TotWords > ( i+1);
end;
0
 
LVL 28

Assisted Solution

by:2266180
2266180 earned 125 total points
ID: 18011038
I didn't look over CodedK's example, but using the code I provided in the other question and to which I added some more methods you simply do something like:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Contnrs;

const WhiteSpaces=[' ',#9{tab},#13,#10];

      punctuation=['.',',','!','?'];

      other=['(',')','+','=','<','>','/','\','{','}','[',']'];
      // I put anything that is not whitspace but is can be a word delimiter here.

      AlphaNumeric=['a'..'z','A'..'Z','0'..'9'];

type TSentence=class
     private
       FWords:TStringList;
       FDelimiters:TStringList;
       function GetCount: integer;
       function GetWord(index: integer): string;
       procedure SetWord(index: integer; const Value: string);
       function GetIsEmpty: boolean;
       function GetText: string;
    function GetNonEmpty: integer;
     public
       constructor Create; overload;
       constructor Create(s:string); overload;
       destructor Destroy; override;

       class function isWordDelimiter(c:char):boolean;

       property Count:integer read GetCount;
       property NonEmpty:integer read GetNonEmpty;
       property Words[index:integer]:string read GetWord write SetWord; default;
       property Text:string read GetText;
       property IsEmpty:boolean read GetIsEmpty;
     end;

     TSentences=class
     private
       FSentences:TObjectList;
       FDelimiters:TStringList;
       function GetCount: integer;
       function GetSentence(index: integer): TSentence;
       function GetText: string;
       function GetNonEmpty: integer;
     public
       constructor Create; overload;
       constructor Create(s:string); overload;
       destructor Destroy; override;

       class function isSentenceDelimiter(c:char):boolean;
       procedure delete(index:integer);

       property Count:integer read GetCount;
       property NonEmpty:integer read GetNonEmpty;
       property Sentences[index:integer]:TSentence read GetSentence; default;
       property Text:string read GetText;
     end;

{ TSentence }

constructor TSentence.Create(s: string);
var i,j:integer; w:string;
begin
  Create;
  i:=1;
  while i<=length(s) do
  begin
    setlength(w,length(s));// maximum possible
    j:=1;
    while (i<=length(s)) and (not isWordDelimiter(s[i])) do
    begin
      w[j]:=s[i];
      inc(i);
      inc(j);
    end;
    dec(j);
    setlength(w,j);
    FWords.Add(w);

    setlength(w,length(s));// maximum possible
    j:=1;
    while (i<=length(s)) and (isWordDelimiter(s[i])) do
    begin
      w[j]:=s[i];
      inc(i);
      inc(j);
    end;
    dec(j);
    setlength(w,j);
    FDelimiters.Add(w);
  end;
end;

constructor TSentence.Create;
begin
  FWords:=TStringList.Create;
  FDelimiters:=TStringList.Create;
end;

destructor TSentence.Destroy;
begin
  FDelimiters.Free;
  FWords.Free;
  inherited;
end;

function TSentence.GetCount: integer;
begin
  result:=FWords.Count;
end;

function TSentence.GetIsEmpty: boolean;
begin
  result:=GetNonEmpty=0;
end;

function TSentence.GetNonEmpty: integer;
var i:integer;
begin
  result:=0;
  for i:=1 to Count do
    if FWords[i-1]<>'' then
      inc(result);
end;

function TSentence.GetText: string;
var i:integer;
begin
  result:='';
  for i:=1 to count do
    result:=result+FWords[i-1]+FDelimiters[i-1];
end;

function TSentence.GetWord(index: integer): string;
begin
  result:=FWords[index];
end;

class function TSentence.isWordDelimiter(c: char): boolean;
begin
  result:=(c in whitespaces) or (c in punctuation) or (c in other);
  // another definition of a word might be: any set oc alphanumerical characters
  // so it all depends on the definition.
end;

procedure TSentence.SetWord(index: integer; const Value: string);
begin
  FWords[index]:=value;
end;

{ TSentences }

constructor TSentences.Create(s: string);
var i,j:integer; t:string;
begin
  Create;
  i:=1;
  while i<=length(s) do
  begin
    setlength(t,length(s));
    j:=1;
    while (i<=length(s)) and (not isSentenceDelimiter(s[i])) do
    begin
      t[j]:=s[i];
      inc(i);
      inc(j);
    end;
    dec(j);
    setlength(t,j);
    FSentences.Add(TSentence.Create(t));

    setlength(t,length(s));
    j:=1;
    while (i<=length(s)) and (isSentenceDelimiter(s[i])) do
    begin
      t[j]:=s[i];
      inc(i);
      inc(j);
    end;
    dec(j);
    setlength(t,j);
    FDelimiters.Add(t);
  end;
end;

constructor TSentences.Create;
begin
  FSentences:=TObjectList.Create(true);
  FDelimiters:=TStringList.Create;
end;

procedure TSentences.delete(index: integer);
begin
  FSentences.Delete(index);
  FDelimiters.Delete(index);
end;

destructor TSentences.Destroy;
begin
  FDelimiters.Free;
  FSentences.Free;
  inherited;
end;

function TSentences.GetCount: integer;
begin
  result:=FSentences.Count;
end;

function TSentences.GetNonEmpty: integer;
var i:integer;
begin
  result:=0;
  for i:=1 to Count do
    if not Sentences[i-1].isEmpty then
      inc(result);
end;

function TSentences.GetSentence(index: integer): TSentence;
begin
  result:=TSentence(FSentences[index]);
end;

function TSentences.GetText: string;
var i:integer;
begin
  result:='';
  assert(Count=FDelimiters.count);
  for i:=1 to Count do
    result:=result+Sentences[i-1].Text+FDelimiters[i-1];
end;

class function TSentences.isSentenceDelimiter(c: char): boolean;
begin
  result:=c in punctuation;
end;

procedure TForm1.FormCreate(Sender: TObject);
var s:tsentences; i:integer;
begin
  memo1.lines.clear;
  memo1.lines.add('word word s. next. making 3 on a line.');
  memo1.lines.add('now splitting');
  memo1.lines.add('one sentence on 2 lines. adding some more.');
  memo1.lines.add('now we have exactly 6 sentences on 4 lines.');
  s:=TSentences.create(memo1.lines.text);

  showmessage(inttostr(s.NonEmpty));

  i:=0;
  while i<s.count do
    if (not s[i].IsEmpty) and (s[i].NonEmpty<=3) then// remove all sentences that have 3 or less words.
      s.delete(i)                                else
      inc(i);

  memo1.lines.text:=s.text;
  s.free;
end;

end.
0
 
LVL 15

Assisted Solution

by:mikelittlewood
mikelittlewood earned 250 total points
ID: 18011040
I changed what I was orginially going to do so replace

if CountWords( sl.Strings[ i]) < TotWords then

with

if CountWords( sl.Strings[ i]) then
0
 
LVL 16

Expert Comment

by:CodedK
ID: 18011049
:/  Argx...
 i was about to post the same code in a demo mikelittlewood..

:)
0
 
LVL 16

Assisted Solution

by:CodedK
CodedK earned 125 total points
ID: 18011091
This is my demo...
It doesnt work with "." but with different lines... :)
http://www.geocities.com/kalatz_gr_fisher/TheFiles/Censor2.zip
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Run video youtube webbrowse 10 65
QRReport  TQrmemo vertical stretching 1 52
Slow Restore if incremental backups using RDiff.exe 4 29
shape, triangle, dbctrlgrid 3 17
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…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

792 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