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

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

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


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


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

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

Статистика

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

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


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

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

Лучшие эксперты данной рассылки

Орловский Дмитрий
Статус: Профессор
Рейтинг: 3642
∙ повысить рейтинг » 		Boriss
Статус: Академик
Рейтинг: 2668
∙ повысить рейтинг » 		Абаянцев Юрий Леонидович aka Ayl
Статус: Профессионал
Рейтинг: 2273
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И СОФТ / Программирование / Pascal (Паскаль)

Номер выпуска:1157
Дата выхода:03.01.2011, 12:30
Администратор рассылки:Boriss (Академик)
Подписчиков / экспертов:187 / 176
Вопросов / ответов:2 / 3

Вопрос № 181662: Здравствуйте, уважаемые эксперты! Прошу Вас ответить на следующий вопрос: Задание: С помощью ПСП сформировать двухмерный MxN массив из элементов. В качестве элементов использовать слова из K..L символов A..Z (одномерный массив символов латин...

Вопрос № 181667: Здравствуйте, уважаемые эксперты! Прошу Вас ответить на следующий вопрос: Тема Массивы и множества. Pascal Вопрос: Даны действительные числа a,b (a<b), натуральное число n, функция y=f(x), определенная на отрезке [a,b]. Для значений аргумен...
Вопрос № 181662:

Здравствуйте, уважаемые эксперты! Прошу Вас ответить на следующий вопрос:
Задание:
С помощью ПСП сформировать двухмерный MxN массив из элементов.
В качестве элементов использовать слова из K..L символов A..Z (одномерный массив символов латинского алфавита).
Таким образом, M и N – соответственно число строк и столбцов формируемой таблицы; K и L – соответственно минимальное и максимальное число букв в формируемых словах – элементах массива.
Осуществить подсчет элементов, удовлетворяющих условиям задания. Проверку заданных условий поиска реализовать с использованием типа множества.
Вывести на экран сформированный массив в виде таблицы, выделив цветом подсчитанные элементы. Ниже вывести результат подсчета выделенных элементов.

Условие задачи
Выделить цветом и подсчитать число слов, удовлетворяющих следующим условиям.
1. Число гласных букв в правой половине слова не меньше, чем в левой.
2. Слово принадлежит строке, в которой есть не менее трех подряд идущих шестибуквенных слов
K=2, L=7, M=20, N=10

Отправлен: 28.12.2010, 20:38
Вопрос задал: Посетитель - 356254 (Посетитель)
Всего ответов: 2
Страница вопроса »

Отвечает Абельхарисов Руслан/Marked One (Профессионал) :
Здравствуйте, Посетитель - 356254!
Вот код программы:
Код:
uses
  crt;

const
  K = 2;
  L = 7;
  M = 20;
  N = 10;
  LS = 6;
  gls = ['a', 'e', 'i', 'o', 'u',
'y'];

function RandomAB(a, b: byte): byte;
begin
  RandomAB := random(b - a + 1) + a;
end;

var
  a: array [1..M, 1..N+1] of string[L];
  len, i, j, y, m1, gl, gr, count, ll: integer;
  b: boolean;

begin
  clrscr;
  randomize;
  count := 0;
  for i := 1 to M do
    for j := 1 to N do
      begin
        a[i, j] := '';
        len := randomAB(K, L);
        for y := 1 to len do
  
         a[i, j] := a[i, j] + chr(randomAB(ord('a'), ord('z')));
      end;

  Textcolor(15);
  for i := 1 to M do
    begin
      m1 := 0;
      y := 0;
      b := false;
      for j := 1 to N do
        begin
          if length(a[i, j]) = LS then
            if not b then
              begin
                y := 1;
                b := true
              end
            else
              inc(y)
          else if b then
         
  begin
              b := false;
              if y > m1 then
                m1 := y;
              y := 0;
            end
        end;
      for j := 1 to N do
        begin
          if m1 >= 3 then
            begin
              gl := 0;
              gr := 0;
              ll := Length(a[i, j]);
              for y := 1 to ll div 2 do
                if a[i, j][y] in gls then
                  inc(gl);
      
         if (ll mod 2) = 0 then
                len := ll div 2 + 1
              else
                len := ll div 2 + 2;
              for y := len to ll do
                if a[i, j][y] in gls then
                  inc(gr);
              if gr >= gl then
                begin
                  inc(count);
                  textColor(12);
                end;
            end;
          write(a[i, j]:(L+1));
          textcolor(15);

        end;
    end;

 WriteLn;
  WriteLn('Count: ', count);
  readln;
end.

Проверял в Free Pascal.
Пример работы:

Удачи!!!

Ответ отправил: Абельхарисов Руслан/Marked One (Профессионал)
Ответ отправлен: 01.01.2011, 16:26
Номер ответа: 265209
Россия
ICQ # 436075880

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

    • Отвечает lamed (Профессор) :
    Здравствуйте, Посетитель - 356254! С Новым годом!
    Используются две функции, что делает код проще. ABC-Pascal
    Код:
    {
    С помощью ПСП сформировать двухмерный MxN массив из элементов.
    В качестве элементов использовать
слова из K..L символов A..Z (одномерный массив символов латинского алфавита).
    Таким образом, M и N – соответственно число строк и столбцов формируемой таблицы; K и L – соответственно минимальное и максимальное число букв в формируемых словах – элементах массива.
    Осуществить подсчет элементов, удовлетворяющих условиям задания. Проверку заданных условий поиска реализовать с использованием типа множества.
    Вывести на экран сформированный массив в виде таблицы, выде
 лив цветом подсчитанные элементы. Ниже вывести результат подсчета выделенных элементов.

    Условие задачи
    Выделить цветом и подсчитать число слов, удовлетворяющих следующим условиям.
    1. Число гласных букв в правой половине слова не меньше, чем в левой.
    2. Слово принадлежит строке, в которой есть не менее трех подряд идущих шестибуквенных слов
    K=2, L=7, M=20, N=10
    }
    uses
      crt;

    const
      K = 2;
      L = 7;
      M = 8; { 20; для тестирования}
      N = 8; { 10; для тестирования}
    
 LS = 6;
      vowels = ['a', 'e', 'i', 'o', 'u', 'y'];

    type
      TMatrix = array[1..M,1..N] of string[L];

    function RandomAB(a, b: byte): byte;
    begin
      RandomAB := random(b - a + 1) + a;
    end;

    function VowelsCmp(s: string): boolean;
    { Возвращает истину, если в правой части слова не меньше гласных ,чем в левой }
    var
      len, half : integer;
      i  : integer;
      LVowels, RVowels: inte
 ger;
    begin
      len := length(s);
      half := len div 2;

      LVowels := 0;
      for i:= 1 to half do
        if s[i] in vowels then
          inc(LVowels);

      RVowels := 0;
      for i:= len-half+1 to len do
        if s[i] in vowels then
          inc(RVowels);
      VowelsCmp := RVowels >= LVowels;
    end;

    function HasNWords(m: TMatrix; cols, nrow, len, count: integer): boolean;
    { Проверка на count и более len-буквенных слов подряд }
    var
      j: integer;
      n: integer;
    begin
    
 HasNWords := false;
      n:= 0;
      for j:= 1 to cols do
        begin
          if length(m[nrow, j])=len then
            inc(n)
          else
            n:= 0;
          if n=count then
            begin
              HasNWords := true;
              exit;
            end;
        end;
    end;

    var
      mat: TMatrix;
      len, i, j, y, count: integer;
      b: boolean;

    begin
      clrscr;
      randomize;
      for i := 1 to M do
        for j := 1 to N do
         
  begin
            mat[i, j] := '';
            len := randomAB(K, L);
            for y := 1 to len do
              mat[i, j] := mat[i, j] + chr(randomAB(ord('a'), ord('z')));
          end;

      count := 0;
      Textcolor(16);
      for i := 1 to M do
        begin
          b:= HasNWords(mat, n, i, 6, 3);
          for j := 1 to N do
            begin
              if b and VowelsCmp(mat[i,j]) then
                begin
                  TextColor(12);
                  inc(count);
       
        end
              else
                TextColor(16);
              write(mat[i, j]:(L+1));
            end;
          WriteLn;
        end;
      WriteLn;
      WriteLn('Всего элементов по условию : ', count);
      readln;
    end.

    Пример работы
    В связи с Новым годом, тестирование и комментарии не были достаточными. Задавайте вопросы в мини -форуме.
    Удачи!

    Ответ отправил: lamed (Профессор)
    Ответ отправлен: 02.01.2011, 19:26
    Номер ответа: 265214
    Россия, Ковров
    Тел.: +79107793141
    Организация: КГТА, УЦ "Альфа"

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

    • Вопрос № 181667:

    Здравствуйте, уважаемые эксперты! Прошу Вас ответить на следующий вопрос:
    Тема Массивы и множества. Pascal
    Вопрос: Даны действительные числа a,b (a<b), натуральное число n, функция y=f(x), определенная на отрезке [a,b]. Для значений аргумента xi=a+ih(i=0,1,...,n),h=(b-a)/n вычислить значения функции yi=f(xi)(i=0,1,...n). Ввести xi и yi (i=0,1,...,n) в виде таблицы из двух колонок. В i-ю строку таблицы заносятся соответствующие значения xi и yi Рассмотреть следующие функции:

    а) y=sin x + cos 2x,a=-π,b=π,n=50;
    б) y=sin (√(2x)) +cos x,a=0,b=2π,n=50;
    в) y=√(x2+2),a = -3,b=5,n=40;
    г) y=x|x+1|,a=-1,b=2,n=30;
    д) y=xe-x,a=-1,b =3,n=40.

    Отправлен: 29.12.2010, 06:38
    Вопрос задал: Никита Николаевич Святов (Посетитель)
    Всего ответов: 1
    Страница вопроса »

    Отвечает Абельхарисов Руслан/Marked One (Профессионал) :
    Здравствуйте, Никита Николаевич Святов!
    Вот код программы:
    Код:
    type
      func = function (x: real): real;

    procedure showfunc(a, b: real; n: integer; f: func);
    var
      i: integer;
      x: real;

    begin
    
 for i := 0 to n do
        begin
          x := a + i * ((b - a)/n);
          writeln(x:15:6, '    і ', f(x):15:6);
        end;
    end;

    function pow(c, t: real): real;
    begin
      pow := exp(t*ln(c));
    end;

    function fa(x: real): real; far;
    begin
      fa := sin(x) + cos(2*x);
    end;

    function fb(x: real): real; far;
    begin
      fb := sin(sqrt(2*x)) + cos(x);
    end;

    function fv(x: real): real; far;
    begin
      fv := sqrt(x
 *x + 2);
    end;

    function fg(x: real): real; far;
    begin
      fg := x * abs(x + 1);
    end;

    function fd(x: real): real; far;
    begin
      fd := x * pow(exp(1), -x);
    end;

    begin
      writeln('Var a: ');
      showfunc(-pi, pi, 50, fa);
      readln;

      writeln('Var b: ');
      showfunc(0, 2 * pi, 50, fb);
      readln;

      writeln('Var v: ');
      showfunc(-3, 5, 40, fv);
      readln;

      writeln('Var g: ');
      showfunc(-1, 2, 30, fg);
    
 readln;

      writeln('Var d: ');
      showfunc(-1, 3, 40, fd);
      readln;
    end.

    Пример работы:


    Проверял в Turbo Pascal 7 и в Delphi 2007

    Удачи!!!

    Ответ отправил: Абельхарисов Руслан/Marked One (Профессионал)
    Ответ отправлен: 29.12.2010, 13:15
    Номер ответа: 265168
    Россия
    ICQ # 436075880

    Оценка ответа: 5
    Комментарий к оценке:
    Спасибо, Руслан! Всё безупречно!

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

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

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

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

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

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

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

    © 2001-2011, Портал RFPRO.RU, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Автор: Калашников О.А. | Программирование: Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2010.6.25 от 13.12.2010
    В избранное