www.ispwsznysa.fora.pl

Siwy

to nie sa moje rozwiazania, bo ja sie popłakałem jak to zobaczyłem, ale działa Smile

Zadanie 1
Kod:

program Lista_1_zad_1;

{$APPTYPE CONSOLE}

uses
SysUtils;

const
a_male = 2;
b_male = 3;
c_male = 1;
A_duze = -2;
B_duze = 4;
C_duze = 1;

function Fibonacci(n : Integer) : Integer;
begin
if (n = 0) then Fibonacci := a_male
else if (n = 1) then Fibonacci := b_male
else if (n = 2) then Fibonacci := c_male
else Fibonacci := A_duze * Fibonacci(n - 1) + B_duze * Fibonacci(n - 2) + C_duze * Fibonacci(n - 3);
end;

var
Wyraz : Integer;
Wartosc : Integer;

begin
repeat
Write('Podaj n >= 0 : ');
ReadLn(Wyraz);
until (Wyraz >= 0);
WriteLn;
Wartosc := Fibonacci(Wyraz);
Writeln('Fibonacci wynosi : ',Wartosc);
ReadLn;
{ TODO -oUser -cConsole Main : Insert code here }
end.

Zadanie 2
Kod:

program Lista_1_zad_2;

{$APPTYPE CONSOLE}

uses
SysUtils, Math;

const
a = 1;
b = -1;
c = -1;

function Fibonacci(Wyraz : Word): Real;

function Potega(Liczba : Real; Wykladnik : Word) : Real;
begin // Potega
if (Wykladnik <= 0)
then Potega := 1
else Potega := Liczba * Potega(Liczba, Wykladnik - 1);

end; // Potega

procedure ZnajdzPierwiastki(var x_1 : Real; var x_2 : Real);
var
Delta : Integer;

begin // ZnajdzPierwiastki
Delta := (b * b) - 4 * (a * c);
if (Delta < 0) then
begin
WriteLn;
WriteLn('Zadanie nie moze zostac rozwiazane z powodu braku pierwiastkow!');
WriteLn;
WriteLn('Aby zakonczyc program wcisnij ENTER ...');
ReadLn;
Exit;
end
else if (Delta = 0) then
begin
x_1 := -b / (2 * a);
x_2 := x_1;
end
else begin
x_1 := (-b - Sqrt(Delta)) / (2 * a);
x_2 := (-b + Sqrt(Delta)) / (2 * a);
end;
end; // ZnajdzPierwiastki

var
x_1, x_2 : Real;

begin // Fibonacci
ZnajdzPierwiastki(x_1,x_2);
Fibonacci := (Potega(x_1,Wyraz) - Potega(x_2,Wyraz)) / (x_1 - x_2);
end; // Fibonacci

var
Wyraz : Integer;
Wynik : real;

begin // pr. glowny
repeat
Write('Podaj n : ');
ReadLn(Wyraz);
until(Wyraz >= 0);
WriteLn;
Wynik := Fibonacci(Wyraz);
WriteLn('Fibonacci z ',Wyraz,' : ',Abs(Wynik) : 5:0);
ReadLn;
{ TODO -oUser -cConsole Main : Insert code here }
end. // pr. glowny

Zadanie 3
Kod:

program Lista_1_zad_3;

{$APPTYPE CONSOLE}

uses
SysUtils;

function ObliczCiag(n : Integer):Longint;
begin
if (n <= 1)
then ObliczCiag := 1
else ObliczCiag := ObliczCiag(n - 2) * (n + 2);
end;

var
Wyraz : Integer;
Wynik : Longint;

begin
repeat
Write('Podaj wyraz : ');
ReadLn(Wyraz);
until(Wyraz >= 0);
WriteLn;
Wynik := ObliczCiag(Wyraz);
WriteLn(Wyraz,' wyraz ciagu wynosi : ',Wynik);
ReadLn;
{ TODO -oUser -cConsole Main : Insert code here }
end.

Zadanie 4
Kod:

program Lista_1_zad_4;

{$APPTYPE CONSOLE}

uses
SysUtils;

const
a = 1;
b = 2;
A_duze = -2;
B_duze = -1;
C_duze = 3;
D_duze = 1;

function Y(n : Integer) : Real; forward;

function X(n : Integer) : Real;
begin
if (n <= 0)
then X := a
else X := A_duze * X(n - 1) + B_duze * Y(n - 1);
end;

function Y(n : Integer) : Real;
begin
if (n <= 0)
then Y := b
else Y := C_duze * X(n - 1) + D_duze * Y(n - 1);
end;

var
Wyraz : Integer;
Wynik : Real;

begin
repeat
Write('Podaj wyraz : ');
ReadLn(Wyraz);
until(Wyraz >= 0);
WriteLn;
Wynik := X(Wyraz);
WriteLn('Wynik dla n = ',Wyraz,' : ',Wynik :5:2);
ReadLn;
{ TODO -oUser -cConsole Main : Insert code here }
end.

Zadanie 5
Kod:

program Lista_1_zad_5;

{$APPTYPE CONSOLE}

uses
SysUtils;

function f(x : Integer):Integer; forward;

function g(x : Integer):Integer;
begin
Write('g');
if (x <= 20)
then g := g(2 * x) div 4
else if (x > 40)
then g := x
else g := 4 * f(x div 2);
end;

function f(x : Integer):Integer;
begin
Write('f');
if (x <= 30)
then f := g(3 * x) div 3
else if (x > 60)
then f := 6 * (x div 3)
else f := 6 * f(x div 6);
end;

var
x, i : Integer;
Wynik : Integer;

begin
repeat
Write('Podaj liczbe <1..20> : ');
ReadLn(i);
until(i in [1..20]);
x := 3 * i;
WriteLn;
Wynik := g(x);
WriteLn('Wynik : ',Wynik);
ReadLn;
{ TODO -oUser -cConsole Main : Insert code here }
end.

Zadanie 6a
Kod:

program Lista_1_zad_6a;

{$APPTYPE CONSOLE}

uses
SysUtils;

procedure Rysuj(n : Integer);
begin
if (n <= 0)
then WriteLn
else begin
Write('*');
Rysuj(n - 1);
end;
end;

var
Poziom : Integer;
Licznik : Integer;

begin
repeat
Write('Podaj poziom : ');
ReadLn(Poziom);
until(Poziom >= 0);
WriteLn;
for Licznik := 1 to Poziom do
Rysuj(Licznik);
ReadLn;
{ TODO -oUser -cConsole Main : Insert code here }
end.

Zadanie 6b
Kod:

program Lista_1_zad_6b;

{$APPTYPE CONSOLE}

uses
SysUtils;

procedure Rysuj(n : Integer);
begin
if (n <= 0)
then WriteLn
else begin
Write('*');
Rysuj(n - 1);
end;
end;

var
Poziom : Integer;
Licznik : Integer;

begin
repeat
Write('Podaj poziom : ');
ReadLn(Poziom);
until(Poziom >= 0);
WriteLn;
for Licznik := Poziom downto 1 do
Rysuj(Licznik);
ReadLn;
{ TODO -oUser -cConsole Main : Insert code here }
end.

Zadanie 7
Kod:

program Lista_1_zad_7;

{$APPTYPE CONSOLE}

uses
SysUtils;

function FromDecToBin(Liczba : Integer):String;
var
Wynik_div : Integer;
Wynik_mod : Integer;

begin
if (Wynik_div = 0)
then exit
else begin
Wynik_div := Liczba div 2;
Wynik_mod := Liczba mod 2;
FromDecToBin := FromDecToBin(Wynik_div) + IntToStr(Wynik_mod);
end;
end;

var
Liczba : Integer;
Wynik : String;

begin
repeat
Write('Podaj liczbe DEC : ');
ReadLn(Liczba);
until(Liczba >= 0);
WriteLn;
Wynik := FromDecToBin(Liczba);
WriteLn('Liczba ',Liczba,' decymalnie to ',Wynik,' binarnie');
ReadLn;
{ TODO -oUser -cConsole Main : Insert code here }
end.

[ Dodano: 2008-02-24, 17:20 ]
Zadanie 8

Kod:
program Lista_1_zad_8;

{$APPTYPE CONSOLE}

uses
SysUtils;

type
TabDyn = array of Real;

function Horner(Tab : TabDyn; x : Real; Ile : Byte):Real;
begin
if (Ile <= 0)
then Horner := Tab[0]
else Horner := Horner(Tab, X, Ile - 1) * X + Tab[Ile];
end;

var
Wspolczynniki : TabDyn;
NajwyzszaPotega : Byte;
Wynik : Real;
Licznik : Integer;
X : Real;

begin
Write('Podaj wartosc najwyzszej potegi wielomiau : ');
ReadLn(NajwyzszaPotega);
WriteLn;
Write('Podaj wartosc X : ');
ReadLn(X);
WriteLn;
Setlength(Wspolczynniki,NajwyzszaPotega + 1);
WriteLn('Wpisz kolejno wspolczynniki wielomianu przy odpowiednich potegach');
WriteLn;
for Licznik := Low(Wspolczynniki) to High(Wspolczynniki) do
begin
Write('Przy potedze [',High(Wspolczynniki) - Licznik,'] : ');
ReadLn(Wspolczynniki[Licznik]);
end;
Wynik := Horner(Wspolczynniki,X,NajwyzszaPotega);
WriteLn;
WriteLn('Suma wielomianu dla X = ',X:5:2,' wynosi : ',Wynik:7:2);
ReadLn;
{ TODO -oUser -cConsole Main : Insert code here }
end.

stramik

no i gitarka Smile

Duzo mniej roboty z algorytmow Smile

Dzieki za rozwiazania

roy · Wysłany: Pon 20:49, 03 Mar 2008 Temat postu:

no i zadanie 9 dla 3 elementow w slupkach - u mnie i tak wywala sie program po wpisaniu liczby wiekszej od 15 :

Grzegorz · Wysłany: Pią 12:12, 07 Mar 2008 Temat postu:

a oto inaczej napisany program ostatniego zadania z listy

program wieza;
{$APPTYPE CONSOLE}
uses
SysUtils;

var
ile,n:longint;
procedure hanoi(n:longint;a,b,c:char);
begin
if n>0 then
begin
hanoi(n-1,a,c,b);
inc(ile);
writeln ('ruch',ile:2,' ':10,a,'=>',b);
hanoi(n-1,c,b,a)
end;
end;

begin
write('podaj n');
readln(n);
hanoi(n,'a','b','c');
readln;
end.