Массивы. дружественные слова

[ksesh]

Помогите, пожалуйста! Сама вообще не могу решить.
Два слова назовем дружественными, если из букв одного можно составить другое и из букв второго составить первое. Даны два слова. Будут ли они дружественными?

[ZX Spectrum-128]

Код не мой, не проверял.

function IsFrendly(d, r: string): boolean;
var
  i: integer;
  b: set of char;
begin
  b := [];
  for i := 1 to length(d) do
    b := b + [d[i]];
  for i := length(r) downto 1 do
    if r[i] in b then
      delete(r, i, 1);
  if length(r) = 0 then
    isfrendly := true
  else
    isfrendly := false;
end;

var
  s, t: string;
begin
  write('Введите первое слово:  ');
  readln(s);
  write('Введите второе слово:  ');
  readln(t);
  if isfrendly(s, t) then
    writeln('Слова дружественные.')
  else
    writeln('Слова недружественные.');
  readln;
end.

[ksesh]

большое спасибо. работает. только глюк в том, что по идее таракан и таран являются недружественными, т.к. из таракан можно составить таран, а из тарана обратно уже никак. а прога пишет дружественные.

[ZX Spectrum-128]

А если так попробовать:

If (isfrendly(s,t)) and (isfrendly(t,s)) then
...

???

[Serge_Bliznykov]

ksesh, а слова ТАРА и АРАРАТ являются дружественными?

[ksesh]

порога считает дружественными. а по идее, же из слова ТАРА АРАРАТ не составишь, не хватает букаф.

[Serge_Bliznykov]

Сообщение от ksesh

порога считает дружественными. а по идее, же из слова ТАРА АРАРАТ не составишь, не хватает букаф.

Вот теперь понятно, что каждую букву из слова можно использовать строго один раз.

проверяйте:

{функция проверку двух строк на "дружественность"}
function IsFriendly(const s, r: string): boolean;
var
  i: integer;
  s2 : string;
begin
  IsFriendly := false;
  s2 := r;
  for i := 1 to length(s) do
    if Pos(s[i], s2) = 0 then Exit  {нет буквы - сразу выход, слова недружественные}
    else Delete(s2, Pos(s[i], s2), 1);  

  isFriendly := length(s2) = 0
end;


begin
  WriteLn( IsFriendly('ЛАТ','ТАЛ'));
  WriteLn( IsFriendly('ТАРА','АРАРАТ'));
  WriteLn( IsFriendly('АРАРАТ','ТАРА'));
  Readln
end.

[ksesh]

вообще никак. не работает.

[Serge_Bliznykov]

Сообщение от ksesh

вообще никак. не работает.

не понял! Что значит "вообще никак не работает"?!
Не запускается? Запускается, но не выдаёт результата? Запускается, но выдаёт ошибку?

я же приложил к функции небольшие тестовые примеры, чтобы убедится, что функция работает. У меня отработало нормально.

Рассказывайте, что Вы делаете и что у Вас не работает!

[Poma][a]

Рассказывайте, что Вы делаете и что у Вас не работает!

Ставлю на "ТС не смог прочитать две строки"..

Как вариант

type
   TArr = array ['A'..'Z'] of Integer;

procedure Init(var s : Tarr);
var
   ch : Char;
begin
   for ch := Low(s) to High(s) do
      s[ch] := 0;
end;

procedure P(var s : Tarr; f : string; value : Integer);
var
   ch : Char;
begin
   for ch in f do
      Inc(s[ch], value)
end;

function Check(s : TArr) : Boolean;
var
   ch : Char;
begin
   Check := FALSE;
   for ch := Low(s) to High(s) do
      if s[ch] <> 0 then Exit;

   Check := TRUE
end;

var
   a, b : string;
   s : TArr;

begin 
   ReadLn(a);
   ReadLn(b);
   Init(s);P(s, a, 1); P(s, b, -1);
   WriteLn(Check(s))
end.