Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на языке Pascal

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 2.943 RSS
←   Апрель 2009   →
 1
 2
 3
 4
 5
 6
06.04.2009
00:32:49
22:17:29
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
20.04.2009
15:37:51
16:49:42
21
22
23
24
25
26
27
28
29
30


За последние 60 дней ни разу не выходила


Сайт рассылки: http://prog.rusfaq.ru/pascal
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

2.943 подписчиков
0 за неделю
←   Все выпуски   →

RusFAQ.ru: Программирование на языке Pascal


Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

РАССЫЛКИ ПОРТАЛА RUSFAQ.RU

Чемпионы рейтинга экспертов в этой рассылке

Botsman
Статус: Студент
Рейтинг: 241
∙ повысить рейтинг >> 		Micren
Статус: Практикант
Рейтинг: 91
∙ повысить рейтинг >> 		Пупорев Юрий Борисович
Статус: Специалист
Рейтинг: 60
∙ повысить рейтинг >>

/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Выпуск № 861
от 23.04.2009, 17:05

Администратор:Калашников О.А.
В рассылке:Подписчиков: 252, Экспертов: 45
В номере:Вопросов: 3, Ответов: 3
Нам важно Ваше мнение об этой рассылке.
Оценить этот выпуск рассылки >>

Вопрос № 165236: прошу помочь решить задачу в паскале Задание: Из множества прямых М, заданных коэффициентами уравнения Ах+Ву+С=0, выбрать прямые: 1) параллельные оси Ох; 2) все пары взаимно перпендикулярных пря...

Вопрос № 165270: Уважаемые эксперты, помогите решить задачку: в результате выполнения фрагмента алгоритма While n<>0 do begin write(2+(n mod 10)); n:=n div 10; end; было напечатано число 117115. Чему было равно значение переменной n перед выпо...
Вопрос № 165283: Доброго времени суток, уважаемые эксперты! <img src="http://rusfaq.ru/images/Forum/5.gif" border="0"> Есть верно работающая программа: <div style="margin:15px; margin-top:10px"><div><b><font color="gray">Код:</font></b></div><pre style="margin: ...

< table width=100% cellpadding=4 class=A>

Вопрос № 165.236
прошу помочь решить задачу в паскале
Задание:
Из множества прямых М, заданных коэффициентами уравнения Ах+Ву+С=0, выбрать прямые:
1) параллельные оси Ох;
2) все пары взаимно перпендикулярных прямых;
3) из взаимно перпендикулярных прямых выбрать те, в которых одна из прямых образует с осью Ох угол, не превосходящий заданный.

Зараенее большое спасибо..
Отправлен: 17.04.2009, 20:30
Вопрос задал: Сафаралиев Альберт Вячеславович (статус: Посетитель)
Всего ответов: 1
Мини-форум вопроса >>> (сообщений: 0)
Отвечает: Тимошенко Дмитрий
Здравствуйте, Сафаралиев Альберт Вячеславович!

Программа в приложении
Коментарии в тексте

С уважением, Дмитрий

Приложение:

Ответ отправил: Тимошенко Дмитрий (статус: 6-й класс)
Ответ отправлен: 18.04.2009, 07:56

Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 247760 на номер 1151 (Россия) | Еще номера >>
  • Отправить WebMoney:
    • Вам помогли? Пожалуйста, поблагодарите эксперта за это!

    Вопрос № 165.270
    Уважаемые эксперты, помогите решить задачку: в результате выполнения фрагмента алгоритма
    While n<>0 do
    begin
    write(2+(n mod 10));
    n:=n div 10;
    end;
    было напечатано число 117115. Чему было равно значение переменной n перед выполнением этого фрагмента алгоритма
    Отправлен: 18.04.2009, 12:35
    Вопрос задала: Семашкина Надежда Сергеевна (статус: Посетитель)
    Всего ответов: 1
    Мини-форум вопроса >>> (сообщений: 4)
    Отвечает: Micren
    Здравствуйте, Семашкина Надежда Сергеевна!
    Значение n было равно 3959
    Код:

    program Pascal_165270;
    const N=117115; { Наше число }
    var
     Number,k:LongInt;
     t:Byte;
    begin
     Number:=N;
     t:=0;
     { В цикле применяем обратное преобразование }
     k:=1;
     while Number<>0
do begin
      t:=t+(Number mod 10)*k;
      if t in [2..11] then begin
       Write(t-2);
       t:=0;
       k:=1;
      end else k:=k*10;
      Number:=Number div 10;
     end;
     WriteLn;
     { Если остаток t не ноль значит входные данные не верны }
     if t<>0 then WriteLn('Data error');
     ReadLn;
    end.

    Результат работы:
    Код:

    3959
    Ответ отправил: Micren (статус: Практикант)
    Ответ отправлен: 18.04.2009, 14:19

    Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 247774 на номер 1151 (Россия) | Еще номера >>
  • Отправить WebMoney:
    • Вам помогли? Пожалуйста, поблагодарите эксперта за это!

    Вопрос № 165.283
    Доброго времени суток, уважаемые эксперты! Есть верно работающая программа:
    Код:
    Program KKR3_10;
    uses crt;
    type Matrix=array[1..9999] of integer;
         DinamicArray=^Matrix;
         Matrica=array[1..999] of DinamicArray;
    var
K,L,i,j,max_j,min_j,buf,A,B:integer;
       InputFile,OutputFile:text;
        X:Matrica;
    begin
      clrscr;
      writeln('Здравствуйте, уважаемый пользователь!');
      writeln('Эта программа в каждом столбце меняет местами наибольший и наименьший по модулю элементы.');
      assign(InputFile,'in.txt');
      reset(InputFile);
      for i:=1 to 1 do
        begin
          for j:=1 to 2 do
            read(InputFile,X[i]^[j]);
        end;
      K
 :=X[1]^[1];
      L:=X[1]^[2];
      for i:=1 to K do
        getmem(X[i],L*sizeof(integer));
      for i:=1 to K do
        begin
          for j:=1 to L do
            read(InputFile,X[i]^[j]);
        end;
      close(InputFile);
      if (K<=0) or (K>50) or (L<=0) or (L>=35) then
        begin
          writeln('Ошибка ввода!!! Введите размерность в файле 0<K<=50 и 0<L<=35.');
          readln;
          halt;
        end;
      writeln('Вы ввели такую исходную матрицу:');
      for
i:=1 to K do
        begin
          for j:=1 to L do
            write(X[i]^[j]:4,' ');
            writeln;
        end;
      for j:=1 to L do
        begin
          max_j:=X[1]^[i];
          min_j:=X[1]^[i];
          for i:=1 to K do
            begin
              if abs(X[i]^[j])>=max_j then
                begin
                  max_j:=abs(X[i]^[j]);
                  A:=i;
                end;
              if abs(X[i]^[j])<=min_j then
                begin
     
              min_j:=abs(X[i]^[j]);
                  B:=i;
                end;
             end;
           buf:=X[A]^[j];
           X[A]^[j]:=X[B]^[j];
           X[B]^[j]:=buf;
         end;
      assign(OutputFile,'out.txt');
      rewrite(OutputFile);
      writeln('В итоге, получили матрицу:');
      for i:=1 to K do
        begin
          for j:=1 to L do
            begin
              write(X[i]^[j]:4,' ');
              write(OutputFile,X[i]^[j]:4,' ');
            end;
          writeln;
    
     writeln(OutputFile,'');
        end;
      close(OutputFile);
      for i:=1 to K do
        freemem(X[i],L*sizeof(integer));
      readln;
    end.

    И мне её надо разбить на процедуры и функции, и вот что у меня получилось:
    Код:
    Program KKR3_10;
    uses CRT;
    type Matrix=array[1..9999] of integer;
         DinamicArray=^Matrix;
         Matrica=array[1..999] of DinamicArray;

    Procedure CheckingInputSizeOfMatrix(K,L:integer);
    begin
      if (K<=0) or (K>50) or (L<=0) or (L>=35) then
        begin
          writeln('Ошибка ввода!!! Введите размерность в файле 0<K<=50 и 0<L<=35.');
          readln;
          halt;
        end;
    end;

    Procedure InputMatrixFromTxtFile(var X:Matrica;
var K,L:integer);
    var InputFile:text;
        i,j:integer;
    begin
      assign(InputFile,'in.txt');
      reset(InputFile);
      for i:=1 to 1 do
        begin
          for j:=1 to 2 do
            read(InputFile,X[i]^[j]);
        end;
      K:=X[1]^[1];
      L:=X[1]^[2];
      CheckingInputSizeOfMatrix(K,L);
      for i:=1 to K do
        getmem(X[i],L*sizeof(integer));
      for i:=1 to K do
        begin
          for j:=1 to L do
            read(InputFile,X[i]^[j]
 );
        end;
      close(InputFile);
    end;

    Procedure InputedMatrix(X:Matrica; K,L:integer);
    var i,j:integer;
    begin
      writeln('Вы ввели такую исходную матрицу:');
      for i:=1 to K do
        begin
          for j:=1 to L do
            write(X[i]^[j]:4,' ');
            writeln;
        end;
    end;

    Procedure TranspositingMaxMinElementInJ(var X:Matrica; K,L:integer);
    var i,j,buf,A,B,min_j,max_j:integer;
    begin
      for j:=1 to L do
        begin
          max_j:=X[1]^[i];
    
     min_j:=X[1]^[i];
          for i:=1 to K do
            begin
              if abs(X[i]^[j])>=max_j then
                begin
                  max_j:=abs(X[i]^[j]);
                  A:=i;
                end;
              if abs(X[i]^[j])<=min_j then
                begin
                  min_j:=abs(X[i]^[j]);
                  B:=i;
                end;
             end;
           buf:=X[A]^[j];
           X[A]^[j]:=X[B]^[j];
           X[B]^[j]:=buf;
         e
 nd;
    end;

    Procedure OutputMatrixToTxtFile(X:Matrica; K,L:integer);
    var i,j:integer;
        OutputFile:text;
    begin
      assign(OutputFile,'out.txt');
      rewrite(OutputFile);
      writeln('В итоге, получили матрицу:');
      for i:=1 to K do
        begin
          for j:=1 to L do
            begin
              write(X[i]^[j]:4,' ');
              write(OutputFile,X[i]^[j]:4,' ');
            end;
          writeln;
          writeln(OutputFile,'');
        end;
    
 close(OutputFile);
      for i:=1 to K do
        freemem(X[i],L*sizeof(integer));
    end;

    var K,L:integer;
        X:Matrica;
    begin
      clrscr;
      writeln('Здравствуйте, уважаемый пользователь!');
      writeln('Эта программа в каждом столбце меняет местами наибольший и наименьший по модулю элементы.');
      InputMatrixFromTxtFile(X,K,L);
      InputedMatrix(X,K,L);
      TranspositingMaxMinElementInJ(X,K,L);
      OutputMatrixToTxtFile(X,K,L)
 ;
      readln;
    end.

    Не могу понять, где ошибка И ещё вопрос - праильно ли я сделал динамический массив???
    Для проверки:
    входной файл in.txt выходной файл out.txt
    2 2 (размерность матрицы) 3 4
    1 2 1 2
    3 4
    И ещё вопрос, но по другой задаче: нада нарисовать столбцовую диаграмму успеваемости учеников. Я начал делать эту задачу, но в ней постоянно ошибка:
    Код:
    Program KKR4_10;
    uses CRT,Graph;
    const MaxNumberOfStudents=99;
    type TStudent=record
                 Name:string[25];
                 Mark:2..5;
         end;
         TListOfStudents=record
              
            Items:array[1..MaxNumberOfStudents] of TStudent;
                         Count:integer;
         end;
         TJournal=record
                  Group:string[6];
                  Students:TListOfStudents;
         end;
    type ArrayMarks=array[1..4] of integer;

    Procedure InputStudent(var s:TStudent);
    begin
      write(' Ученик: ');
      readln(s.Name);
      write('   Оценка: ');
      readln(s.Mark);
    end;

    Procedure InputListOfStudents(var j:TListOfStudents);
    var i:integer;
    begin
    
 write('Введите число учеников: ');
      readln(j.Count);
      writeln('Список учеников и оценок:');
      for i:=1 to j.Count do
        begin
          write('№',i );
          InputStudent(j.Items[i]);
        end;
      clrscr;
    end;

    Procedure InputJournal(var j:TJournal);
    begin
      write('Класс: ');
      readln(j.Group);
      InputListOfStudents(j.Students);
    end;

    Procedure OutputRegister(mark:byte
 ; Magazine:TJournal);
    var i:integer;
    begin
      writeln(' Класс - ',Magazine.Group);
      writeln('Оценка ученика -  (',mark,'):');
      for i:=1 to Magazine.Students.Count do
        if Magazine.Students.Items[i].Mark=mark then
          writeln(Magazine.Students.Items[i].name);
      readln;
    end;

    {Procedure Diagramma (Magazine:TJournal; var sm:ArrayMarks);
    var i,j:byte;
    begin
      for i:=1 to Magazine.Students.Count do
        if Magazine.Students.Items[i].Mark=2
then
          sm[1]:=sm[1]+1
        else if Magazine.Students.Items[i].Mark=3 then
       sm[2]:=sm[2]+1
        else if Magazine.Students.Items[i].Mark=4 then
          sm[3]:=sm[3]+1
        else if Magazine.Students.Items[i].Mark=5 then
          sm[4]:=sm[4]+1;
        for i:=1 to 4 do
          begin
            textcolor(i);
             write('Kolichestvo ',i+1,'   ');
             for j:=1 to sm[i]*2 do
               write(#178);
             write('  '
 ;,sm[i]);
             writeln;
       end;
      readln;
    end;}

    Function CountCoordinateForY(sm:ArrayMarks):integer;
    var i,y:integer;
    begin
      Y:=sm[i];
      CountCoordinateForY:=round(200/Y);
    end;

    Procedure Diagramma(Magazine:Tjournal; sm:ArrayMarks);
    var driver,mode,Err,i:integer;
    begin
      clrscr;
      driver:=detect;
      InitGraph(driver,mode,'C:BGI');
      Err:=GraphResult;
      if Err<>grOK then
        writeln('Ошибка при инициализации графического режима')
    
 else
        begin
          SetViewPort(0,0,200,300,ClipOff);
          for i:=1 to Magazine.Students.Count do
            if Magazine.Students.Items[i].Mark=2 then
              sm[1]:=sm[1]+1
            else if Magazine.Students.Items[i].Mark=3 then
             sm[2]:=sm[2]+1
            else if Magazine.Students.Items[i].Mark=4 then
              sm[3]:=sm[3]+1
            else if Magazine.Students.Items[i].Mark=5 then
              sm[4]:=sm[4]+1;
          Rect
 angle(CountCoordinateForY(sm[1]),0,0,75);{2}
          Rectangle(CountCoordinateForY(sm[2]),75,0,150);{3}
          Rectangle(CountCoordinateForY(sm[3]),150,0,225);{4}
          Rectangle(CountCoordinateForY(sm[4]),225,0,300);{5}
        end;
    end;

    var j:TJournal;
        sm:ArrayMarks;
    begin
      clrscr;
      InputJournal(j);
      OutputRegister(5,j);
      OutputRegister(4,j);
      OutputRegister(3,j);
      OutputRegister(2,j);
      Diagramma(j,sm);
      readln;
    end.

    Ничего не могу понять
    Помогите пожалуйста)))
    Отправлен: 18.04.2009, 16:40
    Вопрос задал: Gparev (статус: Посетитель)
    Всего ответов: 1
    Мини-форум вопроса >>> (сообщений: 1)
    Отвечает: Тимошенко Дмитрий
    Здравствуйте, Gparev!

    Нашел две ошибки, причем они есть и в исходной программе и в результирующей:

    Этот код в процедуре чтения матрицы
    for i:=1 to 1 do
    begin
    for j:=1 to 2 do
    read(InputFile,X[i]^[j]);
    end;
    K:=X[1]^[1];
    L:=X[1]^[2];

    Лучше заменить на
    read(InputFile,K);
    read(InputFile,L);

    Потому что, во-первых, ваши указатели в этом месте программы указывают "в никуда" - память вы дальше по тексту выделяете, и это может привести к ошибкам при некоторых условиях, а во-вторых не понятно, зачем использовать промежуточные переменные, да еще и в цикле, если можно сразу считывать K и L.

    Вторая ошибка в сортировке матрице:

    Procedure TranspositingMaxMinElementInJ(var X:Matrica; K,L:integer);
    var i,j,buf,A,B,min_j,max_j:integer;
    begin
    for j:=1 to L do
    begin
    max_j:=X[1]^[i]); {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
    min_j:=X[1]^[i]); {!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!}
    for i:=1 to K do
    begin
    if abs(X[i]^[j])>=max_j then

    Отмеченные строки д.б такмим
    max_j:=abs(X[1]^[j])); {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
    min_j:=abs(X[1]^[j])); {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}

    Во-первых, у вас сравниваются модули элементов => abs необходим, тем более что дальше по тексту у вас все идет правильно, иначе при некоторых исходных условиях программа будет давать неверный результат. И второе, в индексе вместо j вы использовали i, которая к этому моменту имеет неопределенное значение. Причем в исходной программе, у вас i=K+1, т.к. ранее по тексту был цикл с ее участием, поэтому ошибки и не было, хотя опять же при определенных исходных условиях она бы возникла, а когда вы перенесли все это дело в процедуру i уже стало неопределенно и стало вызывать ошибку.

    С уважением, Дмитрий
    Ответ отправил: Тимошенко Дмитрий (статус: 6-й класс)
    Ответ отправлен: 19.04.2009, 07:33

    Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 247813 на номер 1151 (Россия) | Еще номера >>
  • Отправить WebMoney:
    • Вам помогли? Пожалуйста, поблагодарите эксперта за это!

    Вы имеете возможность оценить этот выпуск рассылки.
    Нам очень важно Ваше мнение!
    Оценить этот выпуск рассылки >>

    Отправить вопрос экспертам этой рассылки

    Приложение (если необходимо):

    * Код программы, выдержки из закона и т.п. дополнение к вопросу.
    Эта информация будет отображена в аналогичном окне как есть.

    Обратите внимание!
    Вопрос будет отправлен всем экспертам данной рассылки!
    Для того, чтобы отправить вопрос выбранным экспертам этой рассылки или
    экспертам другой рассылки портала RusFAQ.ru, зайдите непосредственно на RusFAQ.ru.


    Форма НЕ работает в почтовых программах The BAT! и MS Outlook (кроме версии 2003+)!
    Чтобы отправить вопрос, откройте это письмо в браузере или зайдите на сайт RusFAQ.ru.

    Скажите "спасибо" эксперту, который помог Вам!

    Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    на короткий номер 1151 (Россия)
    Номер ответа и конкретный текст СМС указан внизу каждого ответа.

    Полный список номеров >>

    * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи. (полный список тарифов)
    ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.

    © 2001-2009, Портал RusFAQ.ru, Россия, Москва.
    Авторское право: ООО "Мастер-Эксперт Про"
    Техподдержка портала, тел.: +7 (926) 535-23-31
    Хостинг: "Московский хостер"
    Поддержка: "Московский дизайнер"
    Авторские права | Реклама на портале

    ∙ Версия системы: 5.13 от 01.12.2008

    		Яндекс Rambler's Top100
    RusFAQ.ru | MosHoster.ru | MosDesigner.ru
    RusIRC.ru | Kalashnikoff.ru | RadioLeader.ru
    В избранное