Страница 1 из 1
Помогите с 2-мя задачками до среды
Добавлено: 21 янв 2008, 21:54
Perf
Всем привет. Задали 2 задачи(Free Pascal), очнеь нужен код программ причом до среды, помогите плиз сам не справлюсь:
1) В данной строке каждый символ с номером кратным К (введённым пользователем) заменить на пробел. Строка читается из файла.
2) Дан массив элементов типа string отсортировать его по алфавиту.
Re: Помогите с 2-мя задачками до среды
Добавлено: 21 янв 2008, 22:25
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]
Re: Помогите с 2-мя задачками до среды
Добавлено: 21 янв 2008, 22:41
Perf
Re: Помогите с 2-мя задачками до среды
Добавлено: 21 янв 2008, 22:49
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]
Re: Помогите с 2-мя задачками до среды
Добавлено: 22 янв 2008, 02:42
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 для нового теста.
Re: Помогите с 2-мя задачками до среды
Добавлено: 22 янв 2008, 11:16
Хыиуду
А первая намного быстрее делается так:
for i:=1 to length(s) div K do s[i*k]:=' ';
Re: Помогите с 2-мя задачками до среды
Добавлено: 22 янв 2008, 16:33
Perf
Всем кто ответил огромное спасибо
Re: Помогите с 2-мя задачками до среды
Добавлено: 23 янв 2008, 12:43
Хыиуду
А сортировка массива есть в разделе "Алгоритмы"