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

RFpro.ru: Программирование на Delphi и Lazarus


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

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

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

Асмик Гаряка
Статус: Академик
Рейтинг: 10580
∙ повысить рейтинг »
Орловский Дмитрий
Статус: Мастер-Эксперт
Рейтинг: 7183
∙ повысить рейтинг »
Boriss
Статус: Академик
Рейтинг: 2315
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И СОФТ / Программирование / Delphi и Lazarus

Номер выпуска:1627
Дата выхода:28.05.2012, 20:00
Администратор рассылки:Киселёва Алёна aka Verena (Академик)
Подписчиков / экспертов:140 / 94
Вопросов / ответов:1 / 1

Консультация # 186118: Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос: Помогите,пожалуйста,выполнить задания на делфи в консоле и напишите пояснения к каждой строчке: 1)Дана строка символов. Преобразовать строку , заменив в ней каждую группу стоящих рядом точек одной точкой 2)Отредактировать заданное предложение, удаляя из него слова, к...


Консультация # 186118:

Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос:
Помогите,пожалуйста,выполнить задания на делфи в консоле и напишите пояснения к каждой строчке:
1)Дана строка символов. Преобразовать строку , заменив в ней каждую группу стоящих рядом точек одной точкой
2)Отредактировать заданное предложение, удаляя из него слова, которые встречаются в предложении заданное число раз.
3)Множество точек на плоскости назовем "регулярным", если вместе с каждой парой раз-личных точек оно содержит также еще одну - - третью вершину правильного треугольника с вершинами в этих точках. Определить, регулярно ли заданное множество точек.

Дата отправки: 20.05.2012, 19:46
Вопрос задал: Бондаренко Сергей Николаевич (Посетитель)
Всего ответов: 1
Страница онлайн-консультации »


Консультирует Сергей Бендер (Профессионал):

Здравствуйте, Бондаренко Сергей Николаевич!

Итак, как мы обсудили, во что получилось.

(Вторая программа получилась какая-то перемудрёная -- да и задание такое.)

1)

Код :
program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var s:string;
    i:integer;
begin
     writeln('Vvedite stroku:');
     readln(s); // читаем строку
     i:=0; // начинаеv перебор символов с нуля
           // (строка может оказыться пустой)
     while i<=length(s)-1 do // пока не дошли последнего
                             // (точка в конце уже не интересует
     begin
          inc(i);  // берём следующий символ
          while (s[i]='.') and ( s[i+1]='.') do
                delete(s,i,1); // проверяем и если надо удалаем
          // пока не ликвидировали цепочку дальше по i не двигаемся
     end;
     writeln('Resultat:',s);
     readln;
end.


2)
Код :
program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var s:string;
    istart1,iend1,istart2,iend2:integer; // начало и конец слова
    n,k:integer;
    w:string;

function NextWord(s:string; var istart,iend:integer):string;
// поиск следующего слова
begin
     inc(iend);
     istart:=iend; // ставим на начало следующего слова, т.е. после пробела
     while (iend<=length(s)) and (s[iend]<>' ') do
     // сдвигаем iend, пока не найдём пробел или конец строки
           inc(iend);
     NextWord:=copy(s,istart,iend-istart); // выделяем найденное слово
end;

begin
     //writeln('Vvedite stroku');
     //readln(s);
     s:='qwe asd zxc rty qwe asd zxc qwe asd qwe';
     writeln('Vvedite kolichestvo povtorov');
     readln(n);
     istart1:=0;
     iend1:=0;
     repeat
           w:=NextWord(s,istart1,iend1); // берём следующее слово
           istart2:=0;
           iend2:=0;
           k:=0;
           while iend2<=length(s) do // двигаемся до конца строки
                if NextWord(s,istart2,iend2)=w // если следующее совпадает с выбранным
                then inc(k);                   // считаем его
           if k=n  // если слово поторяется заданное кооличество раз
           then begin
                delete(s,istart1,iend1-istart1+1);  // удаляем выбранное слово
                                                    // вместе со следующим пробелом
                dec(istart1);
                istart2:=0;
                iend2:=0;
                while iend2<=length(s) do  // снова двигаемся до конца строки
                      if NextWord(s,istart2,iend2)=w // если совпало
                      then begin
                           delete(s,istart2,iend2-istart2+1); // удаляем его
                           dec(istart2);
                           iend2:=istart2;
                      end;

           end;
     until iend1>length(s);
     writeln(s);
     readln;
end.


3)
Код :
program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type point = record
                   x,y:real;
             end;

function IsRegular(a,b,c:point):boolean;
// функция проверяет регулярность трёх точек
// т.е. образуют ли они равносторонний треугольник
var l1,l2,l3:real;
    q:boolean;
begin
     // вычисляем длины сторон
     l1:=sqrt(sqr(a.x-b.x) + sqr(a.y-b.y));
     l2:=sqrt(sqr(a.x-c.x) + sqr(a.y-c.y));
     l3:=sqrt(sqr(b.x-c.x) + sqr(b.y-c.y));
     // проверяем равны между собой все стороны (с точностью до 1e-7)
     IsRegular:= (abs(l1-l2)<1e-7) and (abs(l2-l3)<1e-7);
end;

var s:string;
    i,j,k,n:integer;
    m:array of point;
    flag:boolean;

begin
     // Исходные данные. Задаю в программе -- можно
     // переделать на read.
     n:=7;
     SetLength(m,n);
     m[0].x:=3.00000000000000;   m[0].y:=3.00000000000000;
     m[1].x:=3.50000000000000;   m[1].y:=3.86602540378444;
     m[2].x:=2.50000000000000;   m[2].y:=3.86602540378444;
     m[3].x:=2.00000000000000;   m[3].y:=3.00000000000000;
     m[4].x:=2.50000000000000;   m[4].y:=2.13397459621556;
     m[5].x:=3.50000000000000;   m[5].y:=2.13397459621556;
     m[6].x:=4.00000000000000;   m[6].y:=3.00000000000000;

     flag:=true; // флаг -- признак того, что набор точек регулярен
                 // т.е. пока не найдено комбинации точек,
                 // нарушающей наложенное требование
     i:=0; // Первая точка из пары
     repeat
           j:=i+1;  // Вторая точка из пары (номера до i уже на рассматриваются
           repeat
                 k:=0; // Третья точка
                 while (k<n) and not IsRegular(m[i],m[j],m[k]) do
                 // Перебираем, пока не кончатся точки или пока не встретим
                 // третью точку, образуюущую равност. треугольник с парой
                       inc(k);
                 // writeln(i,' ',j,' ',k<n); // Вывод на экран результата для пары
                 flag:= k<n; // Запоминаем, была ли найдена нужная точка или
                             // индекс k дошёл до конца массива ничего не найдя
                 inc(j);
           until not flag or (j>=n-1); // Выход по флагу или по достижению конца индекса
           inc(i);
     until not flag or (i>=n-2); // Выход по флагу или по достижению конца индекса
     if flag
     then writeln('The set is regular')
     else writeln('The set is NOT regular');
     readln;
end.

Консультировал: Сергей Бендер (Профессионал)
Дата отправки: 27.05.2012, 00:10
Рейтинг ответа:

НЕ одобряю 0 одобряю!


Оценить выпуск | Задать вопрос экспертам

главная страница  |  стать участником  |  получить консультацию
техническая поддержка  |  восстановить логин/пароль

Дорогой читатель!
Команда портала RFPRO.RU благодарит Вас за то, что Вы пользуетесь нашими услугами. Вы только что прочли очередной выпуск рассылки. Мы старались. Пожалуйста, оцените его. Если совет помог Вам, если Вам понравился ответ, Вы можете поблагодарить автора - для этого в каждом ответе есть специальные ссылки. Вы можете оставить отзыв о работе портале. Нам очень важно знать Ваше мнение. Вы можете поближе познакомиться с жизнью портала, посетив наш форум, почитав журнал, который издают наши эксперты. Если у Вас есть желание помочь людям, поделиться своими знаниями, Вы можете зарегистрироваться экспертом. Заходите - у нас интересно!
МЫ РАБОТАЕМ ДЛЯ ВАС!



В избранное