Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 06.05.2008, 23:07   #1
VANOLORD
Пользователь
 
Регистрация: 06.05.2008
Сообщений: 22
По умолчанию Помогите решить 3 задачи

Вообщем ребята прошу, помогите решить задачи, мне просто очень нужно помочь человеку, сам я знаю только Basic, но может быть здесь кто то знает Паскаль, если да, и вам не в лом помочь, напишите пожалуйста

1.Описать процедуру, которая переворачивает список L, т.е. изменяет ссылки в этом списке так, чтобы его элементы оказались расположены в обратном порядке и подсчитывает число вхождений элемента E в список L.

2.Багаж пассажира характеризуется количеством вещей и общим весом вещей. Дан файл f, содержащий информацию о багаже нескольких пассажиров. Дать сведения о багаже, число вещей в котором не меньше, чем в любом другом багаже, а вес вещей не больше, чем в любом другом багаже с этим же числом вещей. (файлы записей)

3.Выдать сведения об учениках 9-х и 10-х классов, поместив вначале сведения об учениках классов 9а…9б..., а затем 10а...10б… (записи)
VANOLORD вне форума
Старый 07.05.2008, 14:55   #2
tempest
 
Регистрация: 07.05.2008
Сообщений: 3
По умолчанию

1) Изначально нужно объявить тип, так как в ТуброП параметры процедур или функций не могут быть нетипизированными массивами:
Код:
type
    arr=array[1..10] of integer;{10 - чисто для примера, можете изменить}
Теперь сам текст процедуры:
Код:
procedure Invers(l:arr; e:integer; z:word);{z - кол-во элементов, это параметр нужен, если его также нужно задавать с клавиатуры}
var
   q, qual:word;
   c:word;
   temp:integer;
begin
     q:=0;
     qual:=z div 2;{половина кол-ва элементов, остаток отпадает, разделим элементы
 наполовину, затем будем заменять 1-й элемент на последний, 2-й - на предпоследний и так 
далее, в нечетном числе будет середина, ее заменять не надо, поэтому остаток отпадает}
     for c:=1 to qual do
     begin
          temp:=l[c];
          l[c]:=l[z+1-c];
          l[z+1-c]:=temp;
          if l[c]=e then inc(q);
          if l[z+1-c]=e then inc(q);
     end;
     for c:=1 to z do
     Write(l[c], ' ');
     Writeln;
     Writeln(q);
end;
Есть и другие алгоритмы, при которых нужно создавать второй массив, но так можно значительно оптимизировать затрачиваемую для программы память и "облегчить" работу процессору, т. е. увеличить скорость (при 10-ти элементах эта оптимизация незаметна, но если, например, 10000 или даже предел 65535/размерность типа(в байтах) (64КБ) , то оптимизация будет довольно заметна).

Сейчас думаю над вторым. Может быть, также выложу решение
tempest вне форума
Старый 07.05.2008, 15:27   #3
tempest
 
Регистрация: 07.05.2008
Сообщений: 3
По умолчанию

2)
Код:
type
    bagazh=record
                 q:word;
                 m:word;
    end;
var
   fin:text;
   i, n, max:word;
   a:array[1..1000] of bagazh;{массив записей}
begin
     assign(fin, 'input.txt');
     reset(fin);
     Readln(fin, n);{считываем кол-во элементов}
     for i:=1 to n do
     Readln(fin, a[i].q, a[i].m);{считываем элементы}
     close(fin);
     max:=1;{номер искомого элемента, задаем начальное значение 1, чтобы не выбило ошибку}
     for i:=1 to n do
     begin
          if (a[i].q>a[max].q) or ((a[i].q=a[max].q) and (a[i].m>a[max].m))
          then max:=i;{если кол-во предметов i-го багажа больше кол-ва предметов наибольшего найденного на данный момент или кол-во 1-го равно кол-ву 2-го и масса предметов 1-го больше, то наибольшему багажу присвоить значение i-го}
     end;
     assign(fin, 'output.txt');
     rewrite(fin);
     Writeln(fin, a[max].q, ' ', a[max].m);
     Close(fin);
end.
Насчет третьего: какая именно информация дана (Ф.И.О., оценки)? Как вводятся данные (файл, клавиатура)?
tempest вне форума
Старый 09.05.2008, 20:09   #4
VANOLORD
Пользователь
 
Регистрация: 06.05.2008
Сообщений: 22
По умолчанию

1) В первой там надо полностью программу, чтоб работала, так непонятно((

2)Во второй пишет File not found. Где там надо файл создать?

3) В третьей дана фамилия и балл, вводятся данные с клавиатуры.
type tsotr=record
fam:string;
ball:string;
klass:string;
bukva:integer;
end;
var f:file of tsotr;
i,n:integer;
l:tsotr;
s:string;
begin
s:='c:/fff.txt';
assign(f,s);
rewrite(f);
writeln('n');
readln(n);
for i:=1 to n do begin
writeln('vvedi fam');
readln(l.fam);
writeln('vvedi ball');
readln(l.ball);
writeln('vvedi klass');
readln(l.klass);
writeln('vvedi bukva');
readln(l.bukva);
write(f,l);
end;
close(f);
reset(f);
for i:=1 to n do begin
read(f,l);
if ????????? then writeln(??????);
end;
close(f);
end.
Как вывести именно в порядке 9а..9б…, 10а…10б ?

3) Дан txt файл. Преобразовать строки файла, удалив после каждой цифры символ, если этот символ не буква.
Var f:text;
j,i,n:integer;
z,s:string;
begin
s:='c:\f.txt';
assign(f,s);
rewrite(f);
readln(n);
for i:=1 to n do begin
readln(z);
write(f,z);
end;
close(f);
rewrite(f);
while not(eof(f)) do begin
read(f,z);
for j:=1 to length(z) do
if (z[j]>='0') and (z[j]<='9') then
begin if not((z[j+1]<='Z') and (z[j+1]>='A'))
then delete(z,j+1,1);
write(f,z);
end;
end;
close(f);
reset(f);
while not(eof(f)) do begin
read(f,z);
write(z);
end;
close(f);
end.

Пишет Fail not open for input. Где в программе ошибка?

Помогите, пожалуйста........
VANOLORD вне форума
Старый 09.05.2008, 21:25   #5
puporev
Старожил
 
Регистрация: 13.10.2007
Сообщений: 2,740
По умолчанию

В суть преобразований не вникал, но по работе с файлами надо так:
Код:
close(f);
reset(f);//открыть для чтения
while not(eof(f)) do begin
read(f,z);
close(f); //закрыть
for j:=1 to length(z) do
if (z[j]>='0') and (z[j]<='9') then
begin if not((z[j+1]<='Z') and (z[j+1]>='A'))
then delete(z,j+1,1);
rewrite(f);//открыть для перезаписи
write(f,z);
end;
end;
close(f);
reset(f);
while not(eof(f)) do begin
read(f,z);
write(z);
end;
close(f);
end.
puporev вне форума
Старый 09.05.2008, 21:42   #6
VANOLORD
Пользователь
 
Регистрация: 06.05.2008
Сообщений: 22
По умолчанию

Спасибо, но всё равно не работает. Указывает на ошибку в этой строчке. Пишет Fail not open for input.
Var f:text;
j,i,n:integer;
z,s:string;
begin
s:='c:\f.txt';
assign(f,s);
rewrite(f);
readln(n);
for i:=1 to n do begin
readln(z);
write(f,z);
end;
close(f);
reset(f);
while not(eof(f)) do begin
read(f,z);
close(f);
for j:=1 to length(z) do
if (z[j]>='0') and (z[j]<='9') then
begin if not((z[j+1]<='Z') and (z[j+1]>='A'))
then delete(z,j+1,1);
rewrite(f);
write(f,z);
end;
end;
close(f);
reset(f);
while not(eof(f)) do begin
read(f,z);
write(z);
end;
close(f);
end.
VANOLORD вне форума
Старый 09.05.2008, 22:51   #7
puporev
Старожил
 
Регистрация: 13.10.2007
Сообщений: 2,740
По умолчанию

Переделал код вашей последней программы. Во-первых, файл должен быть уже создан до пуска прграммы.
Код:
uses crt;
const cf=['0'..'9'];//цифры
      bk=['A'..'Z','a'..'z','А'..'п','р'..'ё'];  //буквы
Var f:text;
j,i,n:integer;
z:array[1..50]of string; //массив строк
s:string;
begin
clrscr;
s:='c:\f.txt';  //заранее созданный файл в указанной директории
assign(f,s);
reset(f);
n:=0;
while not eof(f) do
    begin
      n:=n+1;
      readln(f,z[n]);//считываем строки
      writeln(z[n]);  //выводим на экран(можно убрать)
      for i:=length(z[n]) downto 1 do
      if (z[n][i] in cf) and not (z[n][i+1] in bk)//удаляем символы
      then
        begin
          delete(z[n],i+1,1);
        end;
      writeln(z[n]);//выводим на экран(можно убрать)
    end;
close(f);
rewrite(f);//открываем для перезаписи
for i:=1 to n do
    begin
      writeln(f,z[n]); //записываем в файл
    end;
writeln('Fail f perezapisan!');
readln;
close(f);
end.

Последний раз редактировалось puporev; 10.05.2008 в 06:46. Причина: Исправил ошибку в программе (список букв)
puporev вне форума
Старый 10.05.2008, 09:50   #8
VANOLORD
Пользователь
 
Регистрация: 06.05.2008
Сообщений: 22
По умолчанию

Спасибо ещё раз! Но когда я нажимаю на запуск программы, Паскаль сразу выдает Fail f perezapisan! и всё...может что-то там не так...я уже не знаю...
VANOLORD вне форума
Старый 10.05.2008, 13:10   #9
puporev
Старожил
 
Регистрация: 13.10.2007
Сообщений: 2,740
По умолчанию

Все правильно, ведь на экран ничего не выходит, все записывается в файл. Находите этот файл, открывайте и любуйтесь. Согласно предложенному Вами пути, он находится на диске С. Если Вы хотите видеть файл до перезаписи и после, то вам надо создать второй файл, хотя по условию задачи еужно именно перезаписать существующий. Если все же захотите второй файл, то нужно написать следующее.
Код:
uses crt;   
const cf=['0'..'9'];//цифры   
      bk=['A'..'Z','a'..'z','А'..'п','р'..'ё'];  //буквы   
Var f,g:text;   
j,i,n:integer;   
z:array[1..50]of string; //массив строк   
s:string;   
begin  
clrscr;   
s:='c:\f.txt';  //заранее созданный файл в указанной директории   
s1:='c:\g.txt';
assign(f,s);   
reset(f);   
n:=0;   
while not eof(f) do  
    begin  
      n:=n+1;   
      readln(f,z[n]);//считываем строки   
      writeln(z[n]);  //выводим на экран(можно убрать)   
      for i:=length(z[n]) downto 1 do  
      if (z[n][i] in cf) and not (z[n][i+1] in bk)//удаляем символы   
      then  
        begin  
          delete(z[n],i+1,1);   
        end;   
      writeln(z[n]);//выводим на экран(можно убрать)   
    end;   
close(f);  
assign(g,s1); 
rewrite(g);//открываем для перезаписи   
for i:=1 to n do  
    begin  
      writeln(g,z[n]); //записываем в файл   
    end;   
writeln('Fail g perezapisan!');   
readln;   
close(g);   
end.

Последний раз редактировалось puporev; 10.05.2008 в 13:29.
puporev вне форума
Старый 10.05.2008, 14:49   #10
VANOLORD
Пользователь
 
Регистрация: 06.05.2008
Сообщений: 22
По умолчанию

Спасибо огроменное!!! Наконец-то работает, просто не надо в Паскале вводить строки, а сразу в файле они и потом преобразовываются. Спасибо!
А можете, если Вам не сложно, посмотреть ещё одну:
Выдать сведения об учениках 9-х и 10-х классов, поместив вначале сведения об учениках классов 9а…9б..., а затем 10а...10б… (записи)
Дана фамилия и балл, вводятся данные с клавиатуры.
type tsotr=record
fam:string;
ball:string;
klass:string;
bukva:integer;
end;
var f:file of tsotr;
i,n:integer;
l:tsotr;
s:string;
begin
s:='c:/fff.txt';
assign(f,s);
rewrite(f);
writeln('n');
readln(n);
for i:=1 to n do begin
writeln('vvedi fam');
readln(l.fam);
writeln('vvedi ball');
readln(l.ball);
writeln('vvedi klass');
readln(l.klass);
writeln('vvedi bukva');
readln(l.bukva);
write(f,l);
end;
close(f);
reset(f);
for i:=1 to n do begin
read(f,l);
if ????????? then writeln(??????);
end;
close(f);
end.
Как вывести именно в порядке 9а...9б…, 10а…10б ?
VANOLORD вне форума
Закрытая тема


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
помогите решить задачи!!! black_soul Фриланс 13 21.07.2008 09:22
Помогите решить задачи Andyst Помощь студентам 3 25.12.2007 15:14
ПОМОГИТЕ РЕШИТЬ ЗАДАЧИ С++ lawny Фриланс 1 24.12.2007 20:58
Помогите решить две задачи на С/С++ Сема Помощь студентам 3 24.12.2007 07:31
Помогите решить задачи! Вилен Помощь студентам 2 10.10.2007 23:12