Работа со строками

Code:

function Seps(As_Arg: Char): Boolean;

begin

Seps := As_Arg in

[#0..#$1F, ' ', '.', ',', '?', ':', ';', '(', ')', '/', '\'];

end;

function WordCount(CText: string): Longint;

var

Ix: Word;

Work_Count: Longint;

begin

Work_Count := 0;

Ix := 1;

while Ix <= Length(CText) do

begin

while (Ix <= Length(CText)) and (Seps(CText[Ix])) do

Inc(Ix);

if Ix <= Length(CText) then

begin

Inc(Work_Count);

while (Ix <= Length(CText)) and (not Seps(CText[Ix])) do

Inc(Ix);

end;

end;

Word_Count := Work_Count;

end;

{

To count the number opf words in a TMemo Component,

call: WordCount(Memo1.Text)

}

Code:

{ **** UBPFD *********** by delphibase.endimus ****

>> Подсчет количества слов в строке.

Возвращает количество слов в строке, границы слов определяются в

соответствие с набором разделителей.

Описание параметров:

s - строка, в которой происходит подсчет слов;

Delimiters множество, содержащее символы-разделители слов;

Возвращаемое значение - количество слов

Зависимости: SysUtils, UBPFD.WordScan

Автор: vuk, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.

Copyright: Алексей Вуколов

Дата: 18 апреля 2002 г.

***************************************************** }

function CountWords(const s: string; Delimiters: TSysCharSet): integer;

var

wStart, wLen: integer;

begin

Result := 0;

wStart := 1;

while WordScan(s, wStart, wLen, Delimiters) do

begin

inc(Result);

inc(wStart, wLen);

end;

end;

//Пример использования:

WordCount := CountWords('This is a sample', [' ']);

Code:

// Поиск по корню слова

function RootOfWord(s: string): string;

label

start;

const

sGlas = 'аеёиоуыэюяaeiou'; // With english letters

sSoglas = 'бвгджзйклмнпрстфхцчшщъь';

sCompletions1 = 'й ь s';

sCompletions2 = 'ам ям ом ем ин ём ся ет ит ут ют ат ят ыв ив ев ан ян ов ев ог ег ир ер ых ок ющ ущ er ed';

sCompletions3 = 'енн овл евл ённ анн ост ест';

sAttachments1 = 'в с';

sAttachments2 = 'на за ис из до по вы во со';

sAttachments3 = 'при рас пре про под';

sAttachments4 = 'пере';

var

sResult: string;

i, iCnt, iGlasCount, iCheckCount: integer;

begin

sResult := AnsiLowerCase(Trim(s));

iCheckCount := 0;

start:

// "ся"

if Length(sResult) > 3then

if sResult[Length(sResult) - 1] + sResult[Length(sResult)] = 'ся'then

Delete(sResult, Length(sResult) - 1, 2);

(* E N G L I S H *)

// "ing"

if Length(sResult) > 4then

if sResult[Length(sResult) - 2] + sResult[Length(sResult) - 1] + sResult[Length(sResult)] = 'ing'then

Delete(sResult, Length(sResult) - 2, 3);

// --

// Гласные

if Length(sResult) > 3then

begin

iGlasCount := 0;

for i := Length(sResult) downto1do

if Pos(sResult[i], sGlas) <> 0then// Если последний символ - гласная

inc(iGlasCount)

else

break;

if iGlasCount <> 0then

begin

iGlasCount := iGlasCount - 1;

Delete(sResult, Length(sResult) - iGlasCount, iGlasCount + 1);

end;

end;

// Окончания

if Length(sResult) > 3then

if Pos(sResult[Length(sResult)], sCompletions1) <> 0then

Delete(sResult, Length(sResult), 1);

// "ся"

if Length(sResult) > 3then

if sResult[Length(sResult) - 1] + sResult[Length(sResult)] = 'ся'then

Delete(sResult, Length(sResult) - 1, 2);

if Length(sResult) > 3then

while Pos(sResult[Length(sResult) - 2] + sResult[Length(sResult) - 1] +

sResult[Length(sResult)], sCompletions3) <> 0do

begin

if Length(sResult) > 3then

Delete(sResult, Length(sResult) - 1, 3)

else

break;

end;

if Length(sResult) > 3then

while Pos(sResult[Length(sResult) - 1] + sResult[Length(sResult)], sCompletions2) <> 0do

begin

if Length(sResult) > 3then

Delete(sResult, Length(sResult) - 1, 2)

else

break;

end;

// Гласные

if Length(sResult) > 3then

begin

iGlasCount := 0;

for i := Length(sResult) downto1do

if Pos(sResult[i], sGlas) <> 0then// Если последний символ - гласная

inc(iGlasCount)

else

break;

if iGlasCount <> 0then

begin

iGlasCount := iGlasCount - 1;

Delete(sResult, Length(sResult) - iGlasCount, iGlasCount + 1);

end;

end;

// Приставки

iCnt := 4;

if Length(sResult) > iCnt then

if Pos(Copy(sResult, 1, iCnt), sAttachments4) <> 0then

Delete(sResult, 1, iCnt);

iCnt := 3;

if Length(sResult) > iCnt then

if Pos(Copy(sResult, 1, iCnt), sAttachments3) <> 0then

Delete(sResult, 1, iCnt);

iCnt := 2;

if Length(sResult) > iCnt then

if Pos(Copy(sResult, 1, iCnt), sAttachments2) <> 0then

Delete(sResult, 1, iCnt);

iCnt := 1;

if Length(sResult) > iCnt then

if Pos(Copy(sResult, 1, iCnt), sAttachments1) <> 0then

Delete(sResult, 1, iCnt);

inc(iCheckCount);

if iCheckCount < 2then

goto start;

Result := sResult;

end;

Code:

{

Definition: Permutation

A permutation is an arrangement of n objects, arranged in groups of size r

without repetition where order is important.

P(n,r) = n! / (n-r)!

Example: Find all two-letter permutations of the letters "ABC"

n = ABC

r = 2

Output: AB AC BA BC CA CB

}

{

Definition: Permutation

Eine Permutation ist eine Anordnung von n Objekten ohne Wiederholung.

Dabei spielt die Reihenfolge der Elemente in den Mengen keine Rolle.

P(n,r) = n! / (n-r)!

Beispiel: Finde alle 2-Buchstaben Kombinationen von "ABC"

n = ABC

r = 2

Ergebnis: AB AC BA BC CA CB

}

{

The following is a console Program:

Choose File, New, Console Application

}

program Permute;

{$APPTYPE CONSOLE}

uses SysUtils;

var

R, Slen: Integer;

procedure P(var A: string; B: string);

var

J: Word;

C, D: string;

begin

{ P(N,N) >> R=Slen }

if Length(B) = SLen - R then

begin

Write(' {' + A + '} '); {Per++}

end

else

for J := 1to Length(B) do

begin

C := B;

D := A + C[J];

Delete(C, J, 1);

P(D, C);

end;

end;

var

Q, S, S2: string;

begin

S := ' ';

S2 := ' ';

while (S <> '') and (S2 <> '') do

begin

Writeln('');

Writeln('');

Write('P(N,R) N=? : ');

ReadLn(S);

SLen := Length(S);

Write('P(N,R) R=? : ');

ReadLn(S2);

if s2 <> ''then R := StrToInt(S2);

Writeln('');

Q := '';

P(Q, S);

end;

end.