しりとりのパターンを全パターンするには？ (ID:39018)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

こんな感じでどうですかね？
サンプルなんで、複数解の検討はしてません。
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;

←解決時は質問者本人がここをチェックしてください。

戻る