Массивы

[vadiprog]

Целочисленный массив X из n элементов разбит на m фрагментов. В целочисленном массиве K из m элементов хранятся длины соответствующих фрагментов (все K[i] различны, их сумма равна n). Упорядочить массив K по возрастанию, переставив соотвествующие фрагменты в массиве X.

к примеру есть массив X[10]=1,2,3,4,5,6,7,8,9,10. разделили его на 4 неравные части. 1ый фрагмент: 1,2,3. 2ой: 4. 3ий: 5,6,7,8. 4ий: 9,10. и массив получился к[4]= 3,1,4,2. потом сортируем массив х, чтобы массив к стал упорядочным. тогда будет х[10]=4,9,10,1,2,3,5,6,7,8 и к[4]=1,2,3,4.

Вот как должно работать, помогите программу написать на Delphi

на сколько частей делить вводится с клавиатуры и проверяется равна ли их сума n

люди напишите программу пожалуйста

Что никто не поможет?

[Abstraction]

Мне одному кажется, что этот вопрос уже задавался, и на него был получен ответ? Новая тема-то нахрена?

[Serge_Bliznykov]

"Вы хочите песен? Их есть у меня!"

разбирайтесь.

type 
  TMyArray = array[1..100] of integer;


procedure ExchangeElements( var pX, pK : TMyArray; n_size : integer;
                              Exchange_K_Index1, Exchange_K_Index2 : integer);
var TmpArr : TMyArray;
  i, j, k, 
  One, 
  XStartPos1, XStartPos2,
  Count1, Count2          : integer;
begin

  XStartPos1 := 1;
  for i:=1 to Exchange_K_Index1-1 do
    XStartPos1 := XStartPos1 + pK[i];
  Count1 := pK[Exchange_K_Index1];

  XStartPos2 := 1;
  for i:=1 to Exchange_K_Index2-1 do
    XStartPos2 := XStartPos2 + pK[i];
  Count2 := pK[Exchange_K_Index2];

  {если фрагмент 1 правее фрагмента 2 поменяем их позиции местами}
  if XStartPos1>XStartPos2 then begin
    One := XStartPos1;
    XStartPos1 := XStartPos2;
    XStartPos2 := One;

    One := Count1;
    Count1 := Count2;
    Count2 := One;
  end;

  {теперь "тривиальная" задача - поменять в массиве X 
    фрагмент, начинающийся с элемента XStartPos1 и длиной (количеством элементов) Count1
      с фрагментом, который начинаяется с XStartPos2 и длиной Count2 }

  {поступаем по такому алгоритму. все элементы от XStartPos1 до XStartPos2 копируем во временный массив
    элементы с позиции XStartPos2 пишем на место XStartPos1, 
       после них переписываем все элементы из временного массива - сначала все, что были между фрагментами 1 и 2,
          потом - элементы фрагмента 1}
  for i:=1 to XStartPos2-XStartPos1 do
    TmpArr[i] := pX[XStartPos1+i-1];

  for i:=1 to Count2 do
    pX[XStartPos1 + i - 1] := pX[XStartPos2 + i - 1];

  for i:=Count1+1 to XStartPos2-XStartPos1 do
    pX[XStartPos1 + Count2 + i - Count1 - 1] := TmpArr[i];
  k := XStartPos2-XStartPos1 - Count1;

  for i:=1 to Count1 do
    pX[XStartPos1 + Count2 + i + k - 1] := TmpArr[i];

  {а теперь поменяем местами два элемента в массиве K}
  One := pK[Exchange_K_Index1];
  pK[Exchange_K_Index1] := pK[Exchange_K_Index2];
  pK[Exchange_K_Index2] := One;
end;

var
  X, K  : TMyArray;
  n, m  : integer;
  i, j, s : integer;
begin

  (*    **** ВВОД ИСХОДНЫХ ДАННЫХ ****        *)
  repeat
    WriteLn('Введите N (от 1 до 100): ');
    Readln(n);
  until (n>=1) and (n<=100);

  {заполним для отладки массив X последовательными значениями
    1, 2, 3 ... N}
  for i:=1 to n do
    X[i] := i;

  repeat
    Write('Введите число фрагментов: (от 2 до ',n,'): ' );
    Readln(m);
  until (m>=2) and (m<=n);

  repeat
    s := 0;
    for i:=1 to m do begin
      repeat
        Write('Длина ',i,' фрагмента: ');
        Readln(K[i]);
      until (K[i]>=1) and (K[i]<=n);
      s := s + K[i];
    end; 
    if s<>n then begin
        WriteLn('Вы неверно внесли длины фрагментов. Их суммарная длина должна быть ',n);
        WriteLn('Попытайтесь ещё раз!')
    end;
  until s=n;


  (* *** Сортировка *** *)

  {сортировка массива методом простых обменов ("пузырька") }
  for i:=1 to m-1 do
    for j:=i+1 to m do
      if K[i] > K[j] then
          ExchangeElements( X, K, n, i, j);


  (* *** Вывод результирующих массивов *** *)
  WriteLn;  Write('Массив K: ');
  for i:=1 to m do Write(K[i]:2,' ');
  WriteLn;

  WriteLn;  Write('Массив X: ');
  for i:=1 to n do Write(X[i]:2,' ');
  WriteLn;

  Readln;  
end.

ДОБАВЛЕНО

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

Мне одному кажется, что этот вопрос уже задавался, и на него был получен ответ? Новая тема-то нахрена?

ну где Вы раньше были?!! Тогда я бы не стал писать и приводить свой код....
да и вообще, я прозевал явный кросспостинг!

[vadiprog]

Я вот написал прогу... может подкоректируете?

uses
  SysUtils;
var X: array[1..1000] of integer;
    K: array[1..100] of integer;
    m,i,n,z,s,l,p:integer;
begin
 l:=1;
 p:=1;
 s:=0;
 m:=1;
 i:=0;
 writeln('Vvedit kilkist simvoliv v masivi');
 readln(z);
 writeln('Vvedit masiv');
 for n:=1 to z do
  readln (X[n]);
 writeln('Vvedit na skilku simvoliv rozbit');
  while s<>z do
   begin
   readln(K[m]);
   s:=s+K[m];
   m:=m+1;
   i:=i+1;
   end;
 for m:=p to i do
   if ((K[m])=p) then p:=l;
 begin
  for n:=1 to (K[m]) do
     begin
      X[l]:=X[n];
      l:=l+1;
     end;
 end;
for l:=1 to z do
write(X[l]);
readln;
end.

Что никто не подкоректирует?

[Serge_Bliznykov]

Что никто не подкоректирует?

Вам дал алгоритм Abstraction.

я Вам дал готовую рабочую программу.
Чем она Вас не устраивает?

итого, в активе два решения.

И теперь Вы простите "подкорректировать" код, выполняющий неизвестно что по известному только Вам алгоритму...

Ладно. Давайте, расскажите, каким алгоритмом Вы пытаетесь решить задачу?
(распишите алгоритм подробно).
Ну и поясните нам, что именно в вашем коде нужно "подкорректировать"?..