Помогите с 2-мя задачками до среды

[Perf]

Всем привет. Задали 2 задачи(Free Pascal), очнеь нужен код программ причом до среды, помогите плиз сам не справлюсь:
1) В данной строке каждый символ с номером кратным К (введённым пользователем) заменить на пробел. Строка читается из файла.
2) Дан массив элементов типа string отсортировать его по алфавиту.

[MOTOCoder]

Вот решение первой(компилил в TP 7, но под fpc тоже должно сработать):
[syntax='delphi']
program p1;
var
N:integer;
str1,str2:string;
f:text;
i:integer;
begin
writeln('Введите N');
readln(n);
assign(f,'INPUT.TXT');
reset(f);
readln(f,str1);
close(f);

for i:=1 to length(str1) do
begin
if ((i mod N)=0) then
str2:=str2+' '
else
str2:=str2+str1;
end;

writeln('Исходная строка:');
writeln(str1);
writeln('Результат обработки:');
writeln(str2);
readln;
end.
[/syntax]

[Perf]

Огромное спасибо, MOTOCoder респект тебе

[MOTOCoder]

Вот вторая.
Алгоритм не самый лучший, но работает.
Констатна N должна быть на 1 больше числа строк.
[syntax='delphi']
program sortarr;
const
N=5;
var
data:array[0..N]of string;
x,i:integer;
f:text;

procedure insert(idx:integer;str:string);
var j:integer;
begin
for j:=N-1 downto idx do
data[j+1]:=data[j];
data[idx]:=str;
end;

procedure delete(idx:integer);
var j:integer;
begin
for j:=idx to n-1 do
data[j]:=data[j+1];
end;

procedure sort;

begin
for i := 0 to (N-1) do
for x := 0 to (N - 1) do
if (data[x] < data) and (x > i) then
begin
Insert(i, data[x]);
Delete(x+ 1);
end;
end;

begin
assign(f,'input.txt');
reset(f);
for i:=1 to 4 do
readln(f,data);
close(f);
for i:=1 to 4 do
writeln(data);
sort;
for i:=1 to 4 do
writeln(data);
readln;

end.
[/syntax]

[drummer]

Пишите более конкретно условия задач. А то сразу появляется куча вопросов:
1. Есть ли одновременно большие и маленькие буквы.
2. Используются ли одновременно русские буквы и латинские (если да то в каком порядке выводить)
3. 1+2

Код: Выделить всё

var a:array of string;
    s,x:string;
    i,n:longint;

procedure qsort(l,r:longint);
  var i,j:longint;
  begin
      i:=l;
      j:=r;
      x:=a[(l+r) div 2];
      repeat
          while a[i]<x do inc(i);
          while a[j]>x do dec(j);
          if i<=j then
              begin
                  s:=a[i];
                  a[i]:=a[j];
                  a[j]:=s;
                  inc(i);
                  dec(j);
              end;

      until i>j;
      if i<r then qsort(i,r);
      if j>l then qsort(l,j);
  end;

procedure input;
  begin
          readln(n);
          setlength(a,n+1);
          for i:=1 to n do
             readln(a[i]);
  end;

procedure output;
   begin
           for i:=1 to n do
              writeln(a[i]);
   end;

begin
        input;
        qsort(1,n);
        output;
end.
   

Думаю это будет работать побыстрее.
К тому же не надо менять каждый раз константу n для нового теста.

[Хыиуду]

А первая намного быстрее делается так:
for i:=1 to length(s) div K do s[i*k]:=' ';

[Perf]

Всем кто ответил огромное спасибо

[Хыиуду]

А сортировка массива есть в разделе "Алгоритмы"