VPF::Подсчет количества анаграмм - Форум программистов

ProofF

Дата 14.12.2008, 00:30 (ссылка)

(нет голосов)

Загрузка ...

Новичок

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

Репутация: нет
Всего: нет

1) Для данного слова линой до 12 символов подсчитать число различных анаграмм (слов полученных перестановкой его букв).
Пример: лото Ответ: 12
Имеются ввиду сова: лото, лтоо, оолт, олот, олто, тоол, толо, тлоо, оотл, отло, отол

тест:
лостос              60
молоток            840
сопроцессор     554400
энциклопедия  239500800

Кароче, если в слове все буквы разные тогда всё просто, находится по формуле z:=y!   где y-количество букв в слове. Если же имеются повторяющиеся буквы, то формула следующая: z:=y!/x!   где y-количество букв в слове, а x-количество повторяющихся букв. Если кто не в курсе факториал n!=1*2*3*4*...*n

При следующем решении программа проходит только первый тест:

Код

program anagramm;
function factorial(n:integer):longint;
begin
  if n=0 then factorial:=1 else factorial:=n*factorial(n-1);
  end;
var x:string; g,s,z,p,k:integer;m:real;
begin
writeln('Vvedite slovo dlinoy do 12 simvolov');
readln(x);
p:=length(x);
k:=1;
z:=1;
for s:=1 to (p-1) do
  begin
    for g:=s+1 to p do
    begin
    if (x[s]=x[g]) then z:=z+1; 
    end;
  end;
m:=(factorial(p))/(factorial(z));
writeln('Chislo anagramm = ',m);
readln;
end.

Нашёл проблему: когда в слове более 2х повторяющихся букв... то 2 цикла, перебирают их еще раз и добавляют к z

Попытался решить так:

Код

program anagramm;
function factorial(n:integer):longint;
begin
  if n=0 then factorial:=1 else factorial:=n*factorial(n-1);
  end;
var x,y:string; g,s,z,p,k:integer;m:real;
begin
writeln('Vvedite slovo dlinoy do 12 simvolov');
readln(x);
p:=length(x);
k:=1;
z:=1;
y[1]:=' ';
for s:=1 to (p-1) do
  begin
    for g:=s+1 to p do
    begin
    if (x[s]=x[g]) and (x[s]<>y[1]) then z:=z+1; y[1]:=x[s];
    end;
  end;
m:=(factorial(p))/(factorial(z));
writeln('Chislo anagramm = ',m);
readln;
end.

Но при таком раскладе даже первый тест почему то не проходит((( Прошу, помогите

Добавлено @ 00:31
И еще, может кто поможет еще с такой задачей:
2) Первое слово необходимо преобразовать во второе, используя наименьшее количество следующих действий:
   1. удалений символов
   2. замен символа на любой другой
Программа должна:
  1. Запросить исходное слово ( до 20 символов), которое будет преобразовываться
  2. Запросить слово которое нужно получить
  3. Для найденного самого короткого преобразования выполненного по правилам сообщить:
      а) число удалений
      б) число замен
      в) для контроля слово, образовавшееся после выполнения всех удалений и слово результат
или сообщить что преобразование невозможно
Пример. Исходные данные: корова, свора. Ответ: удалений 1, замен 3, после удаления - коова, итог - свора

Тесты

переулок, пешеход                       удалений 1, замен 3, после удаления - переуок
молот, молоток                              невозможно
энциклопедия, махаон                  удалений 6, замен 5, после удаления - энциоп
полиметилметакрилат, метромост    удалений 10, замен 4, после удаления - метилтетт

Помогите плз, заранее спасибо!

Модератор: Пожалуйста, один топик - один вопрос.

Это сообщение отредактировал(а) ProofF - 14.12.2008, 13:00

Данкинг

Дата 14.12.2008, 00:34 (ссылка)

(нет голосов)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: нет
Всего: 130

А свои наработки явишь миру? smile

--------------------

There's nothing left but silent epitaphs.

volvo877

Дата 14.12.2008, 03:20 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

ProofF,

Цитата(ProofF @ 13.12.2008, 23:30

)

лостос 60

Наверное, все-таки не "лостос", а "лотос"?

Вот это должно проходить все тесты:

Код

program anagramm;

function factorial(n: integer): longint;
begin
  if n = 0 then factorial := 1
  else factorial := n * factorial(n - 1);
end;

var
  s: string;
  i: integer;
  fact: longint;
  counts: array[1 .. 12] of integer;

begin
  writeln('Vvedite slovo dlinoy do 12 simvolov');
  readln(s);
  for i := 1 to 12 do counts[i] := 0;
  for i := 1 to length(s) do inc(counts[pos(s[i], s)]);

  fact := factorial(length(s));
  for i := 1 to 12 do begin
    fact := fact div factorial(counts[i]);
  end;

  writeln('Chislo anagramm = ',fact);
  readln;
end.

ProofF

Дата 14.12.2008, 11:50 (ссылка)

(нет голосов)

Загрузка ...

Новичок

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

Репутация: нет
Всего: нет

Большое спасибо! ну да, само собой лотос... а то я провозился уже хз сколько времени...

navi

Дата 14.12.2008, 11:55 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

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

Репутация: нет
Всего: нет

Цитата(ProofF @ 14.12.2008, 11:50

)

а то я провозился уже хз сколько времени...

если проблема решена то желательно отмечать как решённый! ссори за smile

--------------------

Хакер не преступник! Взлом ради искусства! Смысл в свободе!

ProofF

Дата 14.12.2008, 13:01 (ссылка)

(нет голосов)

Загрузка ...

Новичок

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

Репутация: нет
Всего: нет

Еще раз всем спасибо

Это сообщение отредактировал(а) ProofF - 14.12.2008, 16:07

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »