Давайте будем точными: 12 с половиной.
Отличный пример, спасибо!
На лекции было дано домашнее задание: написать программу,которая вычисляет число в n степени,где n >0 и целое. вот мой вариант:
{программа возводит число х в степень n,когда n∈N}
program task1;
begin
writeln('Введи основание степени');
var x := ReadInteger;
writeln('введи показатель степени');
var n := ReadInteger;
writeln('Значение выражения = ', exp(ln(x) * n))
end.
еще есть вариант менее эффективной программы через цикл for:
program task2;
begin
writeln('Введи основание степени');
var x := ReadInteger;
writeln('введи показатель степени');
var n := ReadInteger;
var k, i: integer;
k := 1;
for i := 1 to n do
k := k * x;
writeln('Искомое число = ', k)
end.Задание было другое - сделать это за наименьшее количество умножений
2 лайка
То же задание. Найти a в натуральной степени n за минимальное число умножений. Использован рекурентный алгоритм:
// Задание с лекции. Нахождение a в натуральной степени n за наименьшее число умножений на основе рекурентного алгоритма.
program TaskPower;
function powerm(a, n: integer; var i: integer): biginteger ;
// a - исходное число. n - желаемая степень числа. i - счётчик затраченных умножений.
begin
if n = 1 then // Точка выхода из рекурсии.
result := a
else
if (n mod 3) = 0 then // Случай для n кратно 3
begin
var f := powerm(a, n div 3, i);
i += 2;
result := f * f * f;
end else
if (n mod 2) = 0 then // Случай для n кратно 2
begin
var f := powerm(a, n div 2, i);
i += 1;
result := f * f;
end else
begin// Случай для n не кратно 2 или 3
i += 1;
result := powerm(a, n - 1, i) * a;
end;
end;
begin
var a := readlninteger('Введите исходное число: a=');
var n := readlninteger('Введите степень числа ( n<= 0 - запуск демонстрационного режима): n=');
var ni := 0; // счётчик умножений
if n > 0 then
begin
var r := powerm(a, n, ni);
writelnformat('Исходное число: a={0}; Степень числа: n={1}; Кол-во использованных умножений: {2}; Результат вычислений:{3}; ', a, n, ni, R);
end else
begin
Writeln('Для заданного числа будут выведены 100 первых степеней.');
sleep(2000);
for var i := 1 to 100 do
begin
var R := powerm(a, i, ni);
writelnformat('Исходное число: a={0}; Степень числа: n={1}; Кол-во использованных умножений: {2}; Результат вычислений:{3}; ', a, i, ni, R);
ni := 0;
end;
end;
end.
Task-Power.pas (1,6 КБ)
Иные разложения делаются оптимально для n кратных 5 а не 3 То есть, этот алгоритм - неоптимальный, хотя и лучше степеней 2
begin
writeln('Введите число ');
var a := readreal;
writeln('Введите степень ');
var b := readinteger;
var itog:= 1.0;
var count:=0;
var b1:=b;//сохранить степень для вывода
while b > 0 do
begin
if (b mod 2 = 0) then
begin
a *= a;
b := b div 2;
count+=1;
end
else
begin
itog*= a;
dec(b);;
count+=1;
end;
end;
WriteFormat('Число - {0} степень - {1} результат - {2} минимальное количество операций - {3}',a,b1,itog,count-1);
end.
я модернизировал прошлый алгоритм, исправил баг,но уже отправил , поэтому приходится второй раз это делать( раньше выводил неверно, когда степень числа - степень тройки и при выводе не всегда правильно было)
begin
writeln('Введите число ');
var a := readreal;
writeln('Введите степень ');
var b := readinteger;
var itog := 1.0;
var count := 0;//количество a( кол-во умножений минус 1)
var b1 := b;//сохранить степень для вывода
var a1:=a;
while b > 0 do
begin
if (b mod 2 = 0) then
begin
a *= a;
b := b div 2;
count += 1;
end
else
if (b mod 3 = 0) then
begin
a *= a*a;
b := b div 3;
count += 2;
end
else
begin
itog *= a;
dec(b);
count += 1;
end;
end;
WriteFormat('Число - {0} степень - {1} результат - {2} минимальное количество операций - {3}', a1, b1, itog, count - 1);
end.
1 лайк
Еще один вариант, использован метод динамического программирования
[code]function pow(a:integer; n:integer; var col:integer):int64; //Return a^n (a and n - integers), push to ‘col’ the count of operations begin var arr: array [1…100] of int64; //В массиве будем хранить уже вычисленные степени var res:int64 := a; //Здесь будем накапливать результат arr[1] := a; var st := n; //Сколько степеней нам еще осталось var i := 1; //Текущая степень var j := 1; //Индекс в массиве степеней while (i+i<=n) do //Пока можем вычислять степени, являющиеся квадратами предыдущих степеней - вычисляем begin j+=1; arr[j] := arr[j-1]*arr[j-1]; //Вычисляем следующую степень col+= 1; i+=i; //Удваиваем степень, т.к мы нашли квадрат end; st-= i; //Сколько еще осталось res := arr[j]; //Результат предыдущих вычислений while (st > 0) do begin i := 1; j := 1; while (i+i < st) do begin i +=i; j +=1; end; res *= arr[j]; col+=1; st-=i; end; result := res; end;
begin var i,a,b:integer; writeln(‘Введите число’); read(a); writeln(‘Введите степень’); read(b); writeformat(’{0}^{1}={2}, количество операций - {3}’, a, b, pow(a,b,i), i); end.[/code]
1 лайк
Замена n-ого бита на 1.
begin
var b,a,n:byte;
read(a,n); // вводим число и номер бита
n:=1 shl (n-1); // находим десятичное число, которое в двоичной записи имеет только один бит равный единице на n-ом месте
b:=a or n; // при этом n-ый бит исходного числа в двоичном коде станет равным 1
write(b);
end.
Замена n-ого бита на 0.
begin
var b,a,n:byte;
read(a,n);
n:=1 shl (n-1);
n:= not(n); // всё до этого так же, как и в прошлый раз, но теперь инвертируем полученое число, получая значение, которое в двоичной c.c представляет собой последовательность, состоящую только из единиц, кроме n-ого бита
b:=a and n;
write(b);
end.
Инвертирование n-ого бита.
begin
var b,a,n,m:byte;
read(a,n);
m:=1 shl (n-1);
if a shr (n-1) mod 2 = 0 then // если исходное число при битовом смещении вправо на n-1 становиться четным, значит, n-ый бит равен 0 и мы с помощью or делаем его равным 1
b:=a or m
else
begin
m:= not(m);// а если число при смещении получилось нечетным, мы заменяем нужный бит на о
b:=a and m;
end;
write(b);
end.Так как на изменение бита на 1 и на 0 уже есть решения. Я предложу решение на инвертирование(немного другое).
[code]program byteinvert;
var b: byte; n: integer;
begin writeln(‘введите число и бит ,который нужно изменить’); read(b, n); var a := 1 shl (n - 1); a := not (a); b := (not (a) or b) and (not (b) or a);//эквиваленция writeln(b); end.[/code]
Решение задачи про треугольник. Кратко опишу алгоритм, возможно он не самый лучший. Если точка находится внутри треугольника, то, если провести к ней из вершин треугольника отрезки, то получится, что она разбила треугольник на 3. Следовательно, сумма площадей этих треугольников равна площади большого. Применяя несколько раз формулу Герона, получим искомый результат.
Function Def(var a,b,c,d:real):real; begin Def:=sqrt((b-a)(b-a) + (c-d)(c-d)) end; Function S(var a,b,c,p: real):real; begin S:=sqrt(p*(p-a)(p-b)(p-c)) end; begin var Xa:=ReadReal; var Ya:=ReadReal; var Xb:=ReadReal; var Yb:=ReadReal; var Xc:=ReadReal; var Yc:=ReadReal; var Xs:=ReadReal; var Ys:=ReadReal; var AB:=Def(Xa,Xb,Ya,Yb); var BC:=Def(Xc,Xb,Yc,Yb); var AC:=Def(Xa,Xc,Ya,Yc); var SA:=Def(Xa,Xs,Ya,Ys); var BS:=Def(Xs,Xb,Ys,Yb); var SC:=Def(Xs,Xc,Ys,Yc); var Pabc:=(AB+BC+AC)/2; var Sabc:=S(Pabc,AB,AC,BC); var Psab:=(AB+BS+SA)/2; var Ssab:=S(Psab,SA,AB,BS); var Psac:=(AC+SC+SA)/2; var Ssac:=S(Psac,SA,AC,SC); var Pscb:=(BC+BS+SC)/2; var Sscb:=S(Pscb,BS,BC,SC); writeln(Sabc=Ssac+Sscb+Ssab) end.
2 лайка
Приведу алгоритм решения задачи про четырехугольник. Очевидно, что нас не устраивает вариант, когда АВ пересекается с СD внутри этого “четырехугольника”,т.е когда порядок АСВD. Рассмотрим возможности пересечения AВ и СD. Точка пересечения М может находиться либо между отрезками АD и ВС, либо вне этих отрезков. Если она внутри, то четырехугольника не существует, если она вне, или прямые параллельны, то четырехугольник возможен. Если нарисовать картинку, то факт очевиден.
Дальше просто пишем уравнение всех прямых, находим точку пересечения прямых АВ и СD, а потом проверяем: если подставить координаты точки М в уравнения прямых АС и ВС, и при этом получится, что одна из левых частей уравнений больше нуля, а другая меньше, то четырехугольника не существует. В противном случае такой четырехугольник существует.
P.S. Адекватно реализовать алгоритм в программу не получилось, поэтому привел только сам алгоритм)
Хотелось бы довести до формул
Еще одно решение задачи про треугольник, немного отличающееся от предоставленного выше
program op_task1;
begin
Var Xa, Ya, Xb, Yb, Xc, Yc: real; write('Введите Xa, Ya >> '); readln(Xa, Ya); write('Введите Xb, Yb >> '); readln(Xb, Yb); write('Введите Xc, Yc >> '); readln(Xc, Yc);
//Найдем общую площадь треугольника //Формула S=1/2[(x1-x3)*(y2-y3)-(x2-x3)(y1-y3)]
var So:=abs(1/2*((Xa-Xc)(Yb-Yc)-(Xb-Xc)(Ya-Yc)));
var Xm, Ym: real; write('Введите Xm, Ym >> '); readln(Xm, Ym);
//Найдем сумму треугольников, одна из вершин которой - исходная точка, а две другие - вершины треугольника //Всего таких треугольников будет 3
var S1:=abs(1/2*((Xa-Xm)(Yb-Ym)-(Xb-Xm)(Ya-Ym))); var S2:=abs(1/2*((Xa-Xc)(Ym-Yc)-(Xm-Xc)(Ya-Yc))); var S3:=abs(1/2*((Xm-Xc)(Yb-Yc)-(Xb-Xc)(Ym-Yc)));
var S:=S1+S2+S3;
//Проверяем, “складывается” ли из этих треугольников искомый
if S=So then println(‘Точка принадлежит треугольнику’) else println(‘Точка не принадлежит треугольнику’);
end.
На лекциях было предложено реализовать нерекурсивный вариант решения классической задачи про Ханои.
Рекурсивный вариант из лекции:
procedure Hanoi(f, t, w, n: integer);
begin
if n = 0 then
exit;
Hanoi(f, w, t, n-1);
WritelnFormat('Перенести с {0} на {1}.', f, t);
Hanoi(w, t, f, n-1);
end;
Если представить все возможные переносы дисков в виде дерева, можно заметить, что алгоритм использует инфиксный обход по нему. У меня получился такой вариант итерационного решения:
type
HanoiNode = auto class
f, t, w, n: integer;
function Shift: HanoiNode;
begin
WritelnFormat('Перенести с {0} на {1}.', f, t);
Result := Self;
end;
end;
procedure Hanoi(f, t, w, n: integer);
begin
var s := new Stack<HanoiNode>;
var disc := new HanoiNode(f, t, w, n);
while (s.Count > 0) or (disc.n > 0) do
begin
if disc.n > 0 then
begin
s.Push(disc);
// Условно принимаем в рассмотрение корень всего левого поддерева
disc := new HanoiNode(disc.f, disc.w, disc.t, disc.n - 1);
end
else begin
// Принимаем в рассмотрение корень и сразу выводим сообщение о переносе
disc := s.Pop.Shift;
// Условно принимаем в рассмотрение корень всего правого поддерева
disc := new HanoiNode(disc.w, disc.t, disc.f, disc.n - 1);
end;
end;
end;
Да, принимается. Только метод Shift какой-то странный - функция с побочным действием печати значения
В книге С.А.Абрамов. “Математические построения и программирование”, М., Наука, 1978 глава III параграф 5 приведен отличный разбор задачи “Ханойские башни”, в частности, избавление от рекурсии. Вообще книжечка полезная. Там и деревья и многое другое.
2 лайка
Институт математики, механики и компьютерных наук ЮФУ, 2005–2021