Форум SoftWeb.ru

Форум SoftWeb.ru (https://softweb.ru/index.php)
-   Вопросы и ответы (https://softweb.ru/forumdisplay.php?f=262)
-   -   Решебник (turbo pascal, Delphi) (https://softweb.ru/showthread.php?t=10207)

PaCTaMaH 11.05.2006 18:21

Решебник (turbo pascal, Delphi)
 
Внимание! маленькое вступление.
Надеюсь по названию темы понятно о чем тут спрашивать.
При оформлении вопроса наиболее полно пишите тескт задачи, лучше целиком оригинал (обязательно на русском языке). Старайтесь не делать лишних постов, чтобы в будущем легче было искать нужную вам задачу. Если вы хотите когото устно поблагодорить, пользуйтесь личными сообщениями или кнопкой "спасибо". В этой теме остануться только посты с задачами и их решениями, все лишнее будет удаляться.

Список всех задач: [Ссылки могут видеть только зарегистрированные пользователи. ]
Алгоритмы решения стандартных задач по информатике: [Ссылки могут видеть только зарегистрированные пользователи. ]

Если вы написали свою задачу, а ее никто не решил в течении рабочей недели, составте сообщение-напоминание такого вида: "Кто нить решил задание из сообщения №9?" может про него просто забыли в рабочей канители, и после напоминания, обязательно помогут. Если же вы к тому времени сами или с чей то помощью, решили задачу, то не поленитесь, напишите свое решение, многие будут вам признательны.

Скачать Pascal:
Если у вас дома нет Turbo Pascal, а задание надо сделать за выходные, советую Free Pascal ([Ссылки могут видеть только зарегистрированные пользователи. ])
Так же можете скачать обычный досовский turbo pascal ([Ссылки могут видеть только зарегистрированные пользователи. ])


NEW!!! У нас открылась тема "Решебник С" ([Ссылки могут видеть только зарегистрированные пользователи. ]) просьба к тем кто владеет языком, если будет время, задачи из этого раздела не плохобы продублировать на turbo C. Если тема будет пополняться я ее помечу как "важная".

Overlord

Overlord 06.06.2006 16:54

Re: Решебник (turbo pascal, Delphi)
 
Цитата:

Сообщение от Riddic
Помогите составить программу по Паскалю, условие для нее смотрите ниже:

Составить программу-генератор чисел Пифагора a, b, c (c^2 = a^2 + b^2). В основу положить формулы: a = m^2 – n^2, b = 2mn, c = m^2 + n^2 (m, n – натуральные, 1 < m < k, 1 < n < k, k – данное число). Результат вывести на экран в виде таблицы из пяти столбцов: m, n, a, b, c.

Код:

program Project1;
{$APPTYPE CONSOLE}
uses
  SysUtils;

Сonst k=100000;

var i, j:integer;
    b, a, c:Int64;

begin
  for i:=1 to k do
    for j:=i to k do//for j:=1 to k do
      begin
        a:=(i*i)-(j*j);
        b:=2*i*j;
        c:=(i*i) + (j*j);
        if (a*a=((b*b)+(c*c))){and(a>0)and(b>0)and(c>0)} then
          begin
            writeln('m=', i, ', n=', j, ', A=', a, ', B=', b, ', C=', c, '  ', a, '^2=', b, '^2+', c, '^2');
          end;
      end;
  writeln('Complite');
  readln;
end.

для k меньше 10000 ни нашлось ни чего. а для 100000 уж больно долго считал, но коечто нашел. Еще обрати внимание на закоментированную часть в условии

for j:=i to k do//for j:=1 to k do
поясню: если нам все равно m=1 и n=2 или m=2 и n=1 (и втом и в другом случае результат для вычисления a,b,c одинаковый), используем первый вариант, если разница есть (a=m^n и т.п.) то второй. Первый работает быстрее.

Overlord 06.06.2006 17:03

Re: Решебник (turbo pascal, Delphi)
 
Цитата:

Сообщение от Джони
Пожалуйста помогите составить алгоритм решения задачи: сколько можно купить быков, коров и телят, платя за быка 10р., за корову – 5р., а за теленка – 0,5 р., если на 100 р. надо купить 100 голов скота?

Код:

program Project2;
{$APPTYPE CONSOLE}

uses
  SysUtils;

  var i,j,k, count:integer;

begin
  count:=0;
  for i:=1 to 10 do
    for j:=1 to 20 do
      for k:=1 to 200 do
      begin
        if (i*10)+(j*5)+(k*0.5)=100 then
          begin
              writeln('Bukov ', i, ' Korov ', j, ' Telyat ', k);
              count:=count+1;
          end;
      end;
  writeln('Vsego variantov ', count);
  readln;
end.

Поясню: сколько можно на сто рублей купить быков? 10. Коров? 20. Телят? 200.
Делаем три цикла и сверяем количество покупок с лимитом денег

Shaidar Haran 06.06.2006 18:39

Re: Решебник (turbo pascal, Delphi)
 
Overlord, так ведь нужно чтобы они не только стоили 100 рублей, но и чтобы их всего было 100 штук. Плюс еще быков, коров, телят может быть и 0.
Код:

program Project2;
{$APPTYPE CONSOLE}

uses
  SysUtils;

  var i,j,k, count:integer;

begin
  count:=0;
  for i:=0 to 10 do
    for j:=0 to 20 do
      for k:=0 to 200 do
      begin
        if ((i*10)+(j*5)+(k*0.5)=100) and(i+j+k=100) then
          begin
              writeln('Bukov ', i, ' Korov ', j, ' Telyat ', k);
              count:=count+1;
          end;
      end;
  writeln('Vsego variantov ', count);
  readln;
end.

Тем более так получаем единственный вариант.

Shaidar Haran 07.06.2006 12:38

Re: Решебник (turbo pascal, Delphi)
 
Цитата:

Сообщение от Джони (Сообщение 72921)
Пожалуйста помогите составить алгоритм решения задачи: Упорядочить данный массив английских слов по алфавиту, рассматривая только первый символ каждого слова. Заранее спасибо.

Код:

program Project2;
{$APPTYPE CONSOLE}
uses
  SysUtils;
var
 A:array[1..5] of string[30];
 i,k:integer;
 word:string[30];
begin
 writeln('vvedite slova dlya obrabotki');
 for i:=1 to 5 do
 readln(A[i]);
 for i:=1 to 4 do
                for k:=i to 5 do
                if A[k][1]<A[i][1] then
                begin
                Word:=A[k];
                A[k]:=A[i];
                A[i]:=word;
                end;
 writeln('otsortirovannie slova');
 for i:=1 to 5 do
 writeln(A[i]);
 readln;
end.


Overlord 16.06.2006 08:53

Re: Решебник (turbo pascal, Delphi)
 
Цитата:

Сообщение от Riddic
Помогите написать программу распознающую по длинам сторон среди всех треугольников прямоугольные. Если таковых нет, то вычислить величину угла C.

Мне сказали что тут нужно применить теорему, в которой по трем сторонам находим угл. Только что-то у меня ничего не получается...
Заранее спасибо всем за помощь.

только не угол а его косинус!
Код:

program Project3;

{$APPTYPE CONSOLE}

uses
  SysUtils;
var AB,BC,CA:integer;
    i:integer;
    cosinusC:real;
begin
  write('Vvedite AB ');
  readln(AB);
  write('Vvedite BC ');
  readln(BC);
  write('Vvedite CA ');
  readln(CA);
  cosinusC:=((CA*CA)+(BC*BC)-(AB*AB))/(2*BC*CA);
  if (AB>BC+CA)or(BC>AB+CA)or(CA>BC+AB)then writeln('Takogo treugolnika voobche ne bivaet')
  else if AB*AB=(BC*BC)+(CA*CA) then writeln('ABC pryamougolniy, ugol C = 90')
  else if BC*BC=(AB*AB)+(CA*CA) then writeln('ABC pryamougolniy, ugol A = 90')
  else if CA*CA=(BC*BC)+(AB*AB) then writeln('ABC pryamougolniy, ugol B = 90')
  else writeln('Cos C = ', cosinusC, ' dalshe po tablice Bradisa');//Если я правильно помню теорему косинусов
  readln;
end.

Обязательно проверь теорему косинусов, я ее плохо помню

Overlord 26.06.2006 14:19

Re: Решебник (turbo pascal, Delphi)
 
Цитата:

Сообщение от Riddic
Помогите пожалуйста решить задачу.
1. Даны две дроби А/В и С/D (А, В, С, D - натуральные числа). Составить программу сложения этих дробей. Ответ должен быть несократимой дробью.

Код:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var A,B,C,D,
    CH,//числитель
    ZN,//знаменатель
    CE:integer; //целая часть
begin
  WriteLn('A  C');
  Writeln('- + - = ?');
  Writeln('B  D');
  Writeln;

  write('?A = ');
  readln(A);
  write('?B = ');
  readln(B);
  write('?C = ');
  readln(C);
  write('?D = ');
  readln(D);

  CH:=(A*D)+(C*B);
  ZN:=B*D;
  CE:=CH div ZN;
  CH:=CH mod ZN;

  {if ZN mod CH = 0 then
  begin
    ZN:=ZN div CH;
    CH:=1;
  end; }этот участок сократит дробь если она явно сокращается, необязательный фрагмент

  Writeln;
  Write(CE, ' ');
  if CH>0 then writeln(CH, '/', ZN);  //если есть дробная часть то выводим ее накран
  readln;
end.

Цитата:

3. Найдите произведение цифр заданного натурального числа.
Код:

program Project3;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var i, A, O:integer;
    S:string;
begin
  readln(A);
  S:=IntToStr(A);
  O:=1;
  for i:=1 to length(S) do
  begin
    O:=O*StrToInt(S[i]);
  end;
  writeln(O);
  readln;
end.


Overlord 27.06.2006 12:21

Re: Решебник (turbo pascal, Delphi)
 
Цитата:

Сообщение от Джони
Пожалуйста помогите кто-нибудь решить задачки, а то уже экзамен в четверг, а у меня они не получаются!!!
1. Найти номера всех отрицательных элементов (вывести их на экран), если таких нет, то сообщить об этом.
2. Найти номера всех максимальных элементов.
3. Удалить столбец, в котором находится минимальный элемент.
Заранее БОЛЬШОЕ СПАСИБО!!!

Для элементов чего?
Написал для двухмерного массива
Опять элементов чего?
Для двухмерного массива нашел в каждом столбце максимальный
Что значит удалить? Изменить размерность массива? Надо динамический мамссив использовать?
Заполнил столбец нулями

Код:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var arr:array[0..100, 0..100]of integer;
    max:array[0..100]of integer;
    i,j, min, minI, minJ:integer;
    minus:boolean;
begin
  //от балды заполняем массив, потому что вручную 10000 элементов не хочется
  randomize;
  minus:=false;
  for i:=0 to 100 do
  for j:=0 to 100 do
  begin
    arr[i,j]:=random(1000)-500;//функция random возвращает только положительные числа, что бы в массив попали и отрицательные делаем так
  end;

  min:=arr[0, 0];
  minI:=0;
  minJ:=0;
  for i:=0 to 100 do
  begin
    max[i]:=arr[i, 0];
    for j:=0 to 100 do
    begin
      if arr[i,j] < 0 then
      begin
        writeln('arr[',i,',',j,'] = ', arr[i,j]);//выводим на экран отрицательные
        minus:=true;
      end;
      if arr[i,j] > max[i] then max[i]:=arr[i,j];//определяем максимальный в столбце i
      if arr[i,j] < min then//определяем минимальный во всем массиве
      begin
        min:=arr[i,j];
        minI:=i;
        minJ:=j;
      end;
    end;
  end;

  if minus then writeln('Net otricatelnih');//если в массиве нет отрицательых сообщаем пользователю
  writeln('minimum arr[',minI,',',minJ,'] = ');//выводим на экран столбец и строку минимального элемента

  for j:=0 to 100 do
    arr[minI, j]:=0;//заполняем нулями тот столбец в котором находится минимальный элемент


  for i:=0 to 100 do
  for j:=0 to 100 do
    writeln('arr[',i,',',j,'] = ', arr[i,j]);//показываем весь массив, можно и без этого



  readln;

end.


Overlord 27.06.2006 15:11

Re: Решебник (turbo pascal, Delphi)
 
Цитата:

Сообщение от moyadres1 (Сообщение 75701)
Помогите написать программу, позволяющую ввести строку, состоящую только из цифр и букв. Распечатать те группы цифр, в которых цифра 7 встречается не более двух раз.

Заранее спасибо всем за помощь.

Мне надо на Паскале..

тогда вот
Код:

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

function ValidStr(s:string):boolean;
var i:integer;
begin
  ValidStr:=true;
  for i:=1 to length(S) do
    if (S[i]<'0')or(S[i]>'z') then
//тут придется самому менять условие я не помню в каком порядке символы располагаются.
//Сейчас написано для спучая 0 - 9 -  A - z, т.е. предположительно между 0 и z нет ненужных символов

      begin
        ValidStr:=false;
        writeln('Ne podhodit');
        break;
      end;
end;

function CountInt(s:string):integer;
var i:integer;
begin
  result:=0;
  if length(s)=0 then exit;
  for i:=1 to length(S) do
    if S[i]='7' then result:=result + 1;
end;

var S, subS:string;
    i:integer;
begin
  repeat
    write('?S = ');
    readln(S);
  until ValidStr(S);
  //пока не введена правильная строка повторяем цикл
  i:=1;

//проходим по каждому символу в строке
  repeat
    subS:='';
    while (i<=length(S))and(S[i]>='0')and(S[i]<='9') do
    begin
      subS:=subS + S[i];//формируем подстроки состоящие из цифр
      i:=i+1;
    end;
    if (CountInt(subS)<=2)and(length(subS)<>0) then writeln(subS);
//Если не пустая строка и в ней не больше двух семерок то выводим на экран
    i:=i+1;
  until i>length(S);
 
  readln;
end.


Overlord 27.06.2006 16:00

Re: Решебник (turbo pascal, Delphi)
 
Цитата:

Сообщение от Riddic
Помогите с задачками по паскалю, если не трудно.
--------------------------------------------------------------------------
Дан одномерный массив B, состоящий из 2n элементов. Переставить его элементы по следующему правилу: b[n+1], b[n+2],..., b[2n], b[1], b[2],..., b[n].
--------------------------------------------------------------------------
Определить, если ли в данном массиве строка (столбец), состоящая только из положительных или нулевых элементов.
--------------------------------------------------------------------------
Начиная сk-го столбца, сдвинуть их назад, а последние k поставить на место первых.

вот так переставляем элементы: начиная с k-ого элемента сдвигаем в начало и первые k элементов записываем в конец (я так понял)
Код:

program Project3;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const k = 3;
var B, tmp:array[1..10]of integer;
    i:integer;
begin
  randomize;
  for i:=1 to 10 do
    B[i]:=random(10) - 5;//зполняем числами больше -5 и меньше 5


  for i:=1 to 10 do//смотрим на массив
  writeln(B[i]);


  for i:=1 to 10 do//вся перестановка здесь
    tmp[i]:=B[i];
  for i:=1 to 10 do
    if i < 10 - k then B[i]:=tmp[i + k] else B[i]:=tmp[i - 10 + k];

  writeln; 
  for i:=1 to 10 do//смотрим на массив
  writeln(B[i]);

  readln;
end.

в одномерном массиве в каждом столбце один элемет поэтому если он положительный то условие выполняется (просто в цикле проверить все элементы и если есть положительный вывести на экран сообщение, что в этом столбце он положительный)
если проверять строку, то тогда примерно так

Код:

V:boolean;
begin
  V:=true;
  for i:=1 to 10 do
    if B[i]<0 then V:=false;
  if V then writeln('в массиве только положительные элементы');
end;

вот так вот целиком
Код:

program OverLord;

const k = 3;

var B, tmp:array[1..10]of integer;
    i:integer;
    V:boolean;

begin
  randomize;
  for i:=1 to 10 do
    B[i]:=random(10) - 5;//зполняем числами больше -5 и меньше 5


  for i:=1 to 10 do//смотрим на массив
  writeln(B[i]);


  for i:=1 to 10 do//вся перестановка здесь
    tmp[i]:=B[i];
  for i:=1 to 10 do
    if i < 10 - k then B[i]:=tmp[i + k] else B[i]:=tmp[i - 10 + k];

  writeln;

  v:=true;
  for i:=1 to 10 do
  begin
    writeln(B[i]);
    if B[i]<0 then V:=false;
  end;
  if V then writeln('в массиве только положительные элементы');

  readln;
end.



Часовой пояс GMT +3, время: 13:32.

Работает на vBulletin® версия 3.8.12 by vBS.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot