Строка

[Shift_sk]

Парни помогите!
На районной олимпиаде по информатике дали следующую задачу.
Смыс таков
дано слово
karandash
число
кпримеру
5
и пять члов
dasha drakkar sara kar drama
и сказано подсчитать количество возможных слов которые были составлены из слова karandash правильно(любую букву из слова karandash можно использовать один раз!)

ответ для этого примера равен 3!
помогите кому не лень! уже 3 день сижу над задачей а решение так найти и немогу!

[Roof]

Думаю, что основа решения такая:
Заносим исходное слово (из начальной переменной, например) в переменную BaseWord;
Заносим слово (одно из тех 5-ти) в переменную MyWord;
Теперь берем символ 1 из MyWord и посимвольно перебираем BaseWord.
Если встретили MyWord[1] в BaseWord - значит удаляем этот символ из BaseWord. Далее берем символ 2 из MyWord и опять посимвольно перебираем BaseWord (уже один символ удален) - если встретили, то опять удаляем из BaseWord. И так до конца слова.
Если символ MyWord[n] не встречается в BaseWord - значит обрываем перебор. Если же все символы находятся - значит увеличиваем счетчик возможных слов.
Для другого слова - заново присваиваем BaseWord и MyWord значения.

[Shift_sk]

ммм.... впринцепе я так и решал!но у меня программа прошла только 1 тест из 10!
вот ета строка - обрываем перебор.
это как?

[Shift_sk]

вот код чет неработает!

var s, m: string; 
    p, k, w, t, i: integer;
begin
  read(s, m);
  delete(m, 1, 1);
  p := 1;
  w := 1;
  k := 0;
  while (m <> '') do begin
    if s[p] = m[w] then begin
      delete(s, p, 1);
      delete(m, w, 1);
      p := 1;
    end
    else if s[p] <> m[w] then begin
      p := p + 1;
    end;

    if (m <> '') and (s = '') then begin
      t := t + 0;
    end;

    if m = '' then begin
      t := t + 1;
    end;

    if (m <> '') and (s <> '') then
      if m[w] <> s[length(s)] then begin
        t := t + 0;
      end;
  end;
end;
write(t);
end.

Тэги форматирования кода [СODE]..[/CODE] не забывайте!
Это кнопка с решёточкой (#)
Модератор.

[Shift_sk]

кому интересно вот решение!!!

var a:array[1..255] of integer;s,c:string;
    i,j,p,k,x,n,z:byte;
begin
readln(s);
readln(n);
p:=0;
for i:=1 to length(s) do begin
                                 z:=ord(s[i]);
                                 a[z]:=a[z]+1;
                                end;
for i:=1 to n do begin
                       readln(c);
                       k:=0;
                       for j:=1 to length(c) do begin
                                                         x:=ord(c[j]);
                                                         if a[x]<>0 then begin
                                                                                a[x]:=a[x]-1;
                                                                                k:=k+1;
                                                                              end; 
                                                       end;
                       if  k=length(c) then 
                                            p:=p+1;
                  
                       for j:=1 to 255 do 
                                             a[j]:=0;
                       for j:=1 to length(s) do begin
                                                         z:=ord(s[j]);
                                                         a[z]:=a[z]+1;
                                                       end;
                     end;
 writeln(p);
 end.