Модераторы: Snowy, MetalFan, bems, Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Поиск подстроки в строке, Памогите исправить 
:(
    Опции темы
BenLainus
Дата 19.2.2010, 20:12 (ссылка) | (голосов:2) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 7
Регистрация: 16.2.2010

Репутация: нет
Всего: нет
Помогите найти ошибку пожаааалуйста!!!!!


Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btn1: TButton;
    mmo1: TMemo;
    mmo2: TMemo;
    edt1: TEdit;
    lbl1: TLabel;
    edt2: TEdit;
    lbl2: TLabel;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
type
  TIntVect = array [0..255] of Integer;
  TBMTable = array [0..0] of TIntVect;
  PBMTable = ^TBMTable;
function WCBeginsWith( const P, S : String) : Boolean;

var
  i, lp : Integer;
begin
  Result := False;
  lp := Length(P);
  if lp > Length(S) then Exit;
  for i := 1 to lp do
  if (P[i]<>S[i]) and (P[i]<>'?') and (S[i]<>'?') then Exit;
  Result := True;
end;
function WCFindRightmost( const S, P : String;
  l : Integer) : Integer;
var
  i, j, lp : Integer;
begin
  Result := 0;
  lp := Length(P);
  if lp > l then Exit;
  for i := l - lp + 1 downto 1 do
  for j := 1 to lp do
  if (P[j]<>S[i+j-1]) and (P[j]<>'?') and (S[i+j-1]<>'?')
  then Break
  else if j = lp then
  begin
    Result := i;
    Exit;
  end;
end;
procedure WCMakeBMTable( var BMT : PBMTable;
  const P,S : String);
var
  i, j, lp, MaxShift, CurShift, SufPos : Integer;
  Suffix : String;
begin
  lp := Length(P);
  GetMem(BMT, SizeOf(TIntVect)*lp);
  if P[lp] = '?' then
  for i := 0 to 255 do BMT^[lp-1][i] := 0
  else
  begin
    for i := 0 to 255 do BMT^[lp-1][i] := lp;
    for i := lp downto 1 do
    if BMT^[lp-1][Byte(P[i])] = lp then
    BMT^[lp-1][Byte(P[i])] := lp - i;
  end;
  MaxShift := lp;
  for i := lp - 1 downto 1 do
  begin
    SetLength(Suffix, lp - i);
    Move(P[i+1], Suffix[1], lp - i);
    if WCBeginsWith(Suffix, P) then MaxShift := i;
    if P[i] = '?' then for j := 0 to 255 do BMT^[i-1][j] := 0
    else for j := 0 to 255 do
    begin
      CurShift := MaxShift;
      SetLength(Suffix, lp - i + 1);
      Suffix[1] := Char(j);
      Move(P[i + 1], Suffix[2], lp - i );
      SufPos := WCFindRightmost(P, Suffix, lp - 1);
      if SufPos <> 0 then
      CurShift := i - SufPos;
      BMT^[i-1][j] := CurShift;
    end;
    BMT^[i-1][Byte(P[i])] := 0;
  end;
  end;
function BMSearch(StartPos, lp: Integer; const S: string; BMT: PBMTable):
  Integer;
var
  Pos, i: Integer;
begin
  Pos := StartPos + lp - 1;
  while Pos < Length(S) do
    for i := lp downto 1 do
      if BMT^[i - 1][Byte(S[Pos - lp + i])] <> 0 then
      begin
        Pos := Pos + BMT^[i - 1][Byte(S[Pos - lp + i])];
        Break;
      end
      else if i = 1 then
      begin
        Result := Pos - lp + 1;
        Exit;
      end;
  Result := 0;
end;
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
  var s,p: string; lp,i: integer;
  BMT: PBMTable;
begin
  lp:=StrToint(edt2.Text);
  s:=mmo1.text;
  p:= edt1.text;

mmo2.Lines.Add(inttostr(BMSearch(1,lp,s,p)));

end;
end.



В строчке: 
mmo2.Lines.Add(inttostr(BMSearch(1,lp,s,p)));
пишет: «Incompatible types: String and PBMTable».


M
Rrader		Модератор:  используйте подсветку кода



Это сообщение отредактировал(а) Rrader - 21.2.2010, 05:16
PM MAIL   Вверх
kami
Дата 20.2.2010, 14:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 22
Всего: 72
Цитата(BenLainus @  19.2.2010,  20:12 Найти цитируемый пост)
пишет: «Incompatible types: String and PBMTable»

Правильно пишет.
Потому что p - это string. А BMSearch хочет видеть на этом месте BMT: PBMTable
PM MAIL WWW   Вверх
BenLainus
Дата 20.2.2010, 15:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 7
Регистрация: 16.2.2010

Репутация: нет
Всего: нет
Вот исправил, прога запустилась, но наработает, выводит всё время 0.
Подскажите что делать пожалуйста.

Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btn1: TButton;
    mmo1: TMemo;
    mmo2: TMemo;
    edt1: TEdit;
    lbl1: TLabel;
    edt2: TEdit;
    lbl2: TLabel;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
type
  TIntVect = array [0..255] of Integer;
  TBMTable = array [0..0] of TIntVect;
  PBMTable = ^TBMTable;
function WCBeginsWith( const P, S : String) : Boolean;

var
  i, lp : Integer;
begin
  Result := False;
  lp := Length(P);
  if lp > Length(S) then Exit;
  for i := 1 to lp do
  if (P[i]<>S[i]) and (P[i]<>'?') and (S[i]<>'?') then Exit;
  Result := True;
end;
function WCFindRightmost( const P,S : String;
  l : Integer) : Integer;
var
  i, j, lp : Integer;
begin
  Result := 0;
  lp := Length(P);
  if lp > l then Exit;
  for i := l - lp + 1 downto 1 do
  for j := 1 to lp do
  if (P[j]<>S[i+j-1]) and (P[j]<>'?') and (S[i+j-1]<>'?') 
  then Break
  else if j = lp then
  begin
    Result := i;
    Exit;
  end;
end;
procedure WCMakeBMTable( var BMT : PBMTable;
  const P,S : String);
var
  i, j, lp, MaxShift, CurShift, SufPos : Integer;
  Suffix : String;
begin
  lp := Length(P);
  GetMem(BMT, SizeOf(TIntVect)*lp);
  if P[lp] = '?' then
  for i := 0 to 255 do BMT^[lp-1][i] := 0
  else
  begin
    for i := 0 to 255 do BMT^[lp-1][i] := lp;
    for i := lp downto 1 do
    if BMT^[lp-1][Byte(P[i])] = lp then
    BMT^[lp-1][Byte(P[i])] := lp - i;
  end;
  MaxShift := lp;
  for i := lp - 1 downto 1 do
  begin
    SetLength(Suffix, lp - i);
    Move(P[i+1], Suffix[1], lp - i);
    if WCBeginsWith(Suffix, P) then MaxShift := i;
    if P[i] = '?' then for j := 0 to 255 do BMT^[i-1][j] := 0
    else for j := 0 to 255 do
    begin
      CurShift := MaxShift;
      SetLength(Suffix, lp - i + 1);
      Suffix[1] := Char(j);
      Move(P[i + 1], Suffix[2], lp - i );
      SufPos := WCFindRightmost(P, Suffix, lp - 1);
      if SufPos <> 0 then
      CurShift := i - SufPos;
      BMT^[i-1][j] := CurShift;
    end;
    BMT^[i-1][Byte(P[i])] := 0;
  end;
  end;
function BMSearch(StartPos, lp: Integer; const P,S: string; BMT: PBMTable):
  Integer;
var
  Pos, i: Integer;
begin
  Pos := StartPos + lp - 1;
  while Pos < Length(S) do
    for i := lp downto 1 do
      if BMT^[i - 1][Byte(S[Pos - lp + i])] <> 0 then
      begin
        Pos := Pos + BMT^[i - 1][Byte(S[Pos - lp + i])];
        Break;
      end
      else if i = 1 then
      begin
        Result := Pos - lp + 1;
        Exit;
      end;
  Result := 0;
end;
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
  var p,s: string; lp,i: integer;
  BMT: PBMTable;

begin
  lp:=StrToint(edt2.Text);
  s:=mmo1.text;
  p:= edt1.text;

mmo2.Lines.Add(inttostr(BMSearch(1,lp,p,s,bmt)));

end;
e


Это сообщение отредактировал(а) Rrader - 21.2.2010, 05:17
PM MAIL   Вверх
kami
Дата 21.2.2010, 00:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 22
Всего: 72
Цитата(BenLainus @  20.2.2010,  15:17 Найти цитируемый пост)
, прога запустилась, но наработает, выводит всё время 0.Подскажите что делать пожалуйста.

может, сперва нужно заполнить эту BMT: PBMTable, вызвав WCMakeBMTable?
А чей это код?
PM MAIL WWW   Вверх
BenLainus
Дата 21.2.2010, 16:37 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 7
Регистрация: 16.2.2010

Репутация: нет
Всего: нет
Это алгоритм Бойера-Мура.
Я только начал учить Delphi, поэтому не понимаю нечего в этом коде, можешь исправить там что надо пожалуйста?   
PM MAIL   Вверх
kami
Дата 21.2.2010, 17:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 22
Всего: 72
Цитата(BenLainus @  21.2.2010,  16:37 Найти цитируемый пост)
Это алгоритм Бойера-Мура

Но ведь писали этот код не они, ведь так?
Цитата(BenLainus @  21.2.2010,  16:37 Найти цитируемый пост)
, можешь исправить там что надо

Отличная постановка вопроса. Звучит как "тут что-то не работает, посмотрите, разберитесь и исправьте чтобы работало". С такой постановкой, имхо, в "Центр помощи".
Если бы я знал, что надо исправить - может и исправил бы.  А так - F7 и F5, а так же Watch list помогут в решении проблемы.
Цитата(BenLainus @  21.2.2010,  16:37 Найти цитируемый пост)
Я только начал учить Delphi

Тем более есть смысл разобраться самому в этом.

Это сообщение отредактировал(а) kami - 21.2.2010, 17:27
PM MAIL WWW   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Для новичков | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0640 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.