Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: 6317
Последний выпуск: 19.06.2015

помогите доделать задачу, очень нужно!!! пожалуйста!!!

70K
15 февраля 2012 года
luybeznov
9 / / 08.12.2011
Дано предложение состоящее из N слов разделенные пробелами, надо вывести всевозможные перестановки слов в этом предложении, исключая повторения т.е. перестановки не должны повторяться

вот что я смог сделать:


Код:
uses
SysUtils;

type Combination=array [1..100] of integer;
var N: byte;S:string;p:integer;
j,i:integer;
x: combination;
var a:array[0..100] of string;

// Перевод из строки
procedure Print;
begin

for i:=1 to n do
write(' ',a[x]);
writeln;
end;

procedure swap(var d,j:integer);
var x:integer;
begin
x:=d;
d:=j;
j:=x;
end;

procedure generate(k:byte);
var j:integer;
begin
if k=N then
print
else
for j:=k+1 to n do begin
swap (x[k+1],x[j]);
generate(k+1);
swap (x[k+1],x[j]);
end;
end;
begin

write('vvedite predlogenie: ');readln(s);
s:=s+' '; j:=0;
while copy (s,1,1)=' ' do delete(s,1,1);
while s<>'' do begin
j:=j+1;
while copy (s,1,1)<>' ' do begin
a[j]:=a[j]+copy (s,1,1);
delete (s,1,1);
end;
while copy (s,1,1)=' ' do delete(s,1,1);
end;

N:=j;
for i:=1 to N do x:=i;
generate(0);
readln;

end.


доделайте пожалуйста!!!
14K
16 февраля 2012 года
dsoft
36 / / 08.06.2006
Как вариант:
Код:
program words;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  TCharSet  = TSysCharSet;

var
  Count     : Integer;
  St        : String;
  BufWords  : array[1..100] of String;

function WordCount(const S : String; const WordDelims : TCharSet) : Integer;
var
  SLen, K : Cardinal;
begin
  Result := 0;
  K := 1;
  SLen := Length(S);
  while K <= SLen do
  begin
    while (K <= SLen) and (S[K] in WordDelims) do
      Inc(K);
    if K <= SLen then
      Inc(Result);
    while (K <= SLen) and not(S[K] in WordDelims) do
      Inc(K);
  end;
end;

function WordPosition(const Index : Integer; const S : String; const WordDelims : TCharSet) : Integer;
var
  Count, K : Integer;
begin
  Count := 0;
  K := 1;
  Result := 0;
  while (K <= Length(S)) and (Count <> Index) do
  begin
    while (K <= Length(S)) and (S[K] in WordDelims) do
      Inc(K);

    if K <= Length(S) then
      Inc(Count);

    if Count <> Index then
      while (K <= Length(S)) and not (S[K] in WordDelims) do
        Inc(K)
    else
      Result := K;
  end;
end;

function ExtractWord(Index : Integer; const S : String; const WordDelims : TCharSet) : String;
var
  K, Len : Integer;
begin
  Len := 0;
  K := WordPosition(Index, S, WordDelims);
  if K <> 0 then
    { find the end of the current word }
    while (K <= Length(S)) and not(S[K] in WordDelims) do
    begin
      { add the I'th character to result }
      Inc(Len);
      SetLength(Result, Len);
      Result[Len] := S[K];
      Inc(K);
    end;
  SetLength(Result, Len);
end;

// Перевод из строки
procedure Print;
var
  K : Integer;
begin
  for K := 1 to Count do
    Write(' ', BufWords[K]);
  WriteLn;
end;

procedure Generate(K : Integer);
var
  J : Integer;

  procedure Swap(K, J : Integer);
  var
    Temp : String;
  begin
    Temp        := BufWords[K];
    BufWords[K] := BufWords[J];
    BufWords[J] := Temp;
  end;

begin
  if K = Count then
    Print
  else
    for J := K + 1 to Count do
    begin
      Swap(K + 1, J);
      Generate(K + 1);
      Swap(K + 1, J);
    end;
end;

procedure Main;
var
  K : Integer;
begin
  Write('vvedite predlogenie: ');
  ReadLn(St);

  // считаем количество введённых слов
  Count := WordCount(St, [' ']);

  // заполняем буфер словами
  for K := 1 to Count do
    BufWords[K] := ExtractWord(K, St, [' ']);

  Generate(0);
  ReadLn;
end;

begin
  Main;
end.


Утомил меня этот форум своей простотой, постоянно "выкусывает" символ
I в квадратных скобках. Админу за это уши нужно надрать.
316
16 февраля 2012 года
Alm3n
889 / / 29.05.2009
Цитата: dsoft

Утомил меня этот форум своей простотой, постоянно "выкусывает" символ
I в квадратных скобках. Админу за это уши нужно надрать.


Так загляните в соседний раздел - обсуждение сайта, там есть топик о новом виде форума и выскажите своё мнение.

Знаете кого-то, кто может ответить? Поделитесь с ним ссылкой.

Ваш ответ

Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог