しりとりのパターンを全パターンするには？

スパムちゃんXX 2010-08-19 15:44:58 No: 39017

この質問なんですが、少し気になって。
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1245159807

しりとりの全パターンを検索して、最大値を求める二はどういうアルゴリズムでしょうか？
二木検索かなー？と思ったけど、Delphiって、なかなかいい情報が密からなくって。

再帰でできますか？
再帰は、苦手なスパムちゃんXXでした。

monaa 2010-08-19 20:37:26 No: 39018

こんな感じでどうですかね？
サンプルなんで、複数解の検討はしてません。
function SiriFindNext(aHiraWord:string; var TangoHiraList:TStringList):Integer;
var
  aHiraWordLast:Char;
  i: Integer;
begin
  Result:=-1;
  aHiraWordLast := aHiraWord[Length(aHiraWord)];
  for i := 0 to TangoHiraList.Count - 1 do
    if aHiraWordLast = TangoHiraList.Strings[i][1] then
    begin
      Result := i;
      Exit;
    end;
end;

function SiriSort(var TangoHiraList:TStringList):string;
var
  SortedList:TStringList;
  SortedListMax:TStringList;
  TangoHiraListClone:TStringList;
  SiriEnd:Boolean;
  SiriWord:string;
  i,p,s,Count:Integer;
begin
  SortedList := TStringList.Create;
  SortedListMax := TStringList.Create;
  TangoHiraListClone:=TStringList.Create;
  for i := 0 to TangoHiraList.Count - 1 do
  begin
    TangoHiraListClone.Assign(TangoHiraList);
    SiriWord := TangoHiraListClone.Strings[i];
    SortedList.Clear;
    SortedList.Add(SiriWord);
    TangoHiraListClone.Delete(i);
    repeat
      SiriEnd := True;
      Count := TangoHiraListClone.Count;
      p := 0;
      repeat
        s := SiriFindNext(SiriWord,TangoHiraListClone);
        inc(p);
      until (p>Count) or (s<0);
      if s>=0 then
      begin
        SiriWord := TangoHiraListClone.Strings[s];
        SortedList.Add(SiriWord);
        TangoHiraListClone.Delete(s);
        SiriEnd := (TangoHiraListClone.Count=0);
      end;
    until SiriEnd;
    if SortedList.Count > SortedListMax.Count then
      SortedListMax.Assign(SortedList);
  end;
  Result := SortedListMax.Text;
  SortedList.Free;
  SortedListMax.Free;
  TangoHiraListClone.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  TangoHiraList:TStringList;
begin
  TangoHiraList := TStringList.Create;
  TangoHiraList.Add('りんご');
  TangoHiraList.Add('あんぱんまん');
  TangoHiraList.Add('ごりら');
  TangoHiraList.Add('らっぱ');
  TangoHiraList.Add('ぱんだ');
  TangoHiraList.Add('だちょう');
  ShowMessage(SiriSort(TangoHiraList));
  TangoHiraList.Free;
end;

monaa 2010-08-19 21:13:40 No: 39019

コレ間違えてる…
しばちおまちを。

monaa 2010-08-19 22:50:00 No: 39020

再帰使わないで行けると判断した私が馬鹿でした。
再帰版です。全通りを比較的効率よく集めています。

unit Unit1;

interface

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

type
  TSiritori = class
  private
    procedure GetCount;
  public
    fChildList:TList;
    fParent : TSiritori;
    fLeftList : TStringList;
    fHiraWord : string;
    fCount : Integer;
    Constructor Create(aParent:TSiritori);
    Destructor Destroy; override;
    procedure  Analize(var aBestCount:Integer; aBestList:TList);
    function SiriStr:string;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
Form1: TForm1;

implementation

{$R *.dfm}

//しりとりの判別関数
//濁点の判別を甘くするならここを変更
function HiraConnect(aStrA,aStrB:string):Boolean;
begin
Result := (aStrA[Length(aStrA)] = aStrB[1]);
end;

{ TSiritori }

procedure TSiritori.Analize(var aBestCount:Integer; aBestList:TList);
var
  i,p: Integer;
  Siritori:TSiritori;
begin
  for i := 0 to fLeftList.Count - 1 do
  begin
    if (fParent=nil) or
       (HiraConnect(fHiraWord,fLeftList.Strings[i])) then
    begin
      Siritori := TSiritori.Create(Self);
      Siritori.fLeftList.Assign(fLeftList);
      Siritori.fHiraWord := fLeftList.Strings[i];
      Siritori.fLeftList.Delete(i);
      SiriTori.Analize(aBestCount,aBestList);
    end;
  end;
  GetCount;
  if fChildList.Count=0 then
  begin
    if fCount > aBestCount then
    begin
      aBestCount := fCount;
      aBestList.Clear;
    end;
    if fCount = aBestCount then
      aBestList.Add(Self);
  end;
end;

constructor TSiritori.Create(aParent:TSiritori);
begin
  fParent := aParent;
  fChildList := TList.Create;
  if aParent<>nil then
    aParent.fChildList.Add(Self);
  fLeftList := TStringList.Create;
end;

destructor TSiritori.Destroy;
var
  i: Integer;
begin
  for i := 0 to fChildList.Count - 1 do
    TSiritori(fChildList.Items[i]).Free;
  fLeftList.Free;
  fChildList.Free;
  inherited;
end;

procedure TSiritori.GetCount;
var
  aSiritori:TSiritori;
begin
  fCount := 0;
  aSiritori := Self;
  while aSiritori<>nil do
  begin
    inc(fCount);
    aSiritori := aSiritori.fParent;
  end;
end;

function TSiritori.SiriStr: string;
var
  aSiritori:TSiritori;
begin
  aSiritori := Self;
  Result := '';
  while aSiritori.fParent<>nil do
  begin
    Result := aSiritori.fHiraWord + #$D#$A + Result;
    aSiritori := aSiritori.fParent;
  end;
end;

{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
  Siritori : TSiritori;
  MaxCount:Integer;
  List:TList;
  i: Integer;
begin
  Siritori := TSiritori.Create(nil);
  Siritori.fLeftList.Add('りんご');
  Siritori.fLeftList.Add('ごりら');
  Siritori.fLeftList.Add('ごあ');
  Siritori.fLeftList.Add('あんぱんまん');
  Siritori.fLeftList.Add('ごご');
  Siritori.fLeftList.Add('ごぼう');
  Siritori.fLeftList.Add('らくだ');
  MaxCount := 0;
  List := TList.Create;
  Siritori.Analize(MaxCount,List);
  for i := 0 to List.Count - 1 do
  begin
    ShowMessage(TSiritori(List.Items[i]).SiriStr);
  end;
  Siritori.Free;
end;

end.

monaa 2010-08-19 23:05:23 No: 39021

ちなみに都道府県名しりとりの最長は８個でした。
ふくいいばらききょうととちぎぎふふくおかかながわわかやま

ふくいいばらききょうととちぎぎふふくおかかがわわかやま

都道府県名ひらがな
ほっかいどう
あおもり
いわて
みやぎ
あきた
やまがた
ふくしま
いばらき
とちぎ
ぐんま
さいたま
ちば
とうきょう
かながわ
にいがた
とやま
いしかわ
ふくい
やまなし
ながの
ぎふ
しずおか
あいち
みえ
しが
きょうと
おおさか
ひょうご
なら
わかやま
とっとり
しまね
おかやま
ひろしま
やまぐち
とくしま
かがわ
えひめ
こうち
ふくおか
さが
ながさき
くまもと
おおいた
みやざき
かごしま
おきなわ