PASCAL - Zadaci, resenja, problemi, izazovi...

Bez niza:

Kod:
PROGRAM SUMIRANJE;
   VAR
      A, S: REAL; 
   BEGIN
      S:=0;
      FOR I:=1 TO 100 DO
         BEGIN
            A:=0;
            WRITE('UNESI ',I,'. BROJ: ');
            READLN(A);
            S:=S+A;
         END;
      WRITELN('SUMA SVIH UNETIH BROJEVA JE ',S:7:2);
    READLN
END.


Sa nizom:

Kod:
PROGRAM SUMIRANJE;
   VAR
      A: ARRAY [1..100] OF REAL; 
     S: REAL; 
   BEGIN
      FOR I:=1 TO 100 DO
         BEGIN
            WRITE('UNESI ',I,'. BROJ: ');
            READLN(A[I]);
         END;
      S:=0;
      FOR I:=1 TO 100 DO
         S:=S+A[I];
      WRITELN('SUMA SVIH UNETIH BROJEVA JE ',S:7:2);
    READLN
END.
 
E, evo malo ko zeli da mozga i pomogne... Stvarno mi nema sta gore od kombinacija, permutacija i slicnih gluposti. Problem je sledeci:
Ulazni podaci su: niz x[n] sa vrijednostima novcanica i niz y[n]
sa kolicinom novcanica.
Treba napisati program pomocu koga se odredjuju svi
nacini na koje se suma novca zadata nizovima x i y moze podijeliti na
2 jednaka dijela.
Ako imamo novcanice od po 5, 10 i 50. Novcanica od 5 imamo npr. 12, od 10 - 14, od 50 - 3. Dobijena suma treba da se podijeli sa 2 i da u slucaju djeljivosti tog broja sa 2 ispisemo sve moguce kombinacije sa raspolozivim novcem.
Ako smo dobili npr. sumu 100. Polovinu te sume treba rastaviti sa novce.
50 = 5*4 + 3*10
50 = 5*10
50 = 50*1
50 = 4*10 + 2*5
itd. (lupam malo, ali ajd)
Evo sta sam ja uspio da uradim. Naravno program je skroz pogresno uradjen. Donekle i tacan. Ali sam ovo razbijanje upropastio. Pa mi se cinilo lakse da koristim samo sabiranje umjesto kombinovano sabiranje i mnozenje. (Rjesenje na kraju nema nikakve veze sa novcanicama (ovo sto sam ja ponudio)).
Nadam se da ste razumijeli zadatak... Ko je zainteresovan? ;)

Kod:
Program novcanice;
uses
	crt;
type
	niz = array [1..20] of integer;
	
var
	a, b, z : niz;
	n, w, s, i, j, k, l, m, t, r : integer;
	
Procedure unos(x, y : niz);
var
	i : integer;
begin
	writeln('Unesite vrijednosti novcanica: ');
	for i := 1 to n do
	readln(x[i]);
	writeln('Unesite kolicinu novcanica: ');
	for i := 1 to n do
	begin
		writeln('Koliko ima novcanica "tipa" ',x[i],'?');
		readln(y[i]);
	end;
        for i := 1 to n do
        begin
			s := s + x[i] * y[i];
		end;
end;

function razbijanje(n : integer; x : niz) : integer;
var
	d, i, j : integer;
begin
        d := 1; i := 1;
        while ((d = 1) and (i < n)) do
                begin
                        j := i + 1;
                        while ((d = 1) and (j <= n)) do
                                begin
                                if (x[i] = x[j]) then d := 0;
                                j := j + 1;
                                end;
                        i := i + 1;
                end;
razbijanje := d;
end;

{Function suma_novca(x, y : niz) : integer;
var
	i, s : integer;
begin
	s := 0;
	for i := 1 to n do
	begin
		s := s + x[i] * y[i];
	end;
	suma_novca := s;
end;}
	
Begin
	clrscr;
	writeln('Koliko ima (razlicitih) novcanica? ');
	readln(n);
	unos(a, b);
	{s := 0;
	for i := 1 to n do
	begin
		s := s + a[i] * b[i];
	end;}
	writeln('Suma novca je: ',s,'.'); {ovo s je iz procedure unos}
	readln;
	if ((s mod 2) <> 0) then
		begin
			writeln('GRESKA!');
			writeln; delay(500);
			writeln('Suma novca zadata nizovima a i b se ne moze podijeliti na');
			writeln('dva jednaka dijela te stoga se i ne mogu odrediti trazeni');
			writeln('nacini na koji se suma moze dobiti pomocu datih novcanica!'); readln;
		end
	else
		w := s div 2; {polovina sume novca koja se treba razbiti na 2 dijela}
		{???} {Naravno, slijedi moje standardno i neefikasno snalazenje}
		{Alternativno rjesenje je razbijanje suma na svoje sabirke!
		Na taj nacin se zanemaruju nizovi x i y ali se u datoj (novoj)
		razbijenoj sumi mogu pronaci sabirci koji odgovaraju proizvodu
		kolicine novcanica i vrijednosti novcanice cime bi se dobile trazene sume.}
		
		z[1] := s;
	k:=1;
	while (z[1] > 1) do

        begin
                j := k;
                while (z[j] = 1) do j := j - 1;
                z[j] := z[j] - 1; m := z[j];
                r := 1;
                for l := j + 1 to k do r := r + z[l];
                while (r >= m) do
                        begin
                               j := j + 1;
                                x[j] := m;
                                r := r - m;
                        end;
                        if(r > 0) then
                                begin
                                        j := j + 1;
                                        z[j] := r;
                                end;
                                k := j;
                                if (razbijanje(k, z) = 1) then
                                begin
                                        for t := 1 to k - 1 do
                                        write(z[t],' + ');
                                        write(z[k]);
                                        readln; {program radi, ali naravno ovo se ne trazi}
                                end;


       end;
readln;
end.
 
Mozes rekurzivno da uradis. Napravis neki niz z[n] i tu cuvas koliko si uzeo od kojih.

Kod:
procedure NadjiSumu(suma,PoslednjaNovcanica:integer);
var
   i:integer;
begin
   if PoslednjaNovcanica<n then
      for i:=0 to y[PoslednjaNovcanica+1] do
         begin
            z[PoslednjaNovcanica+1]:=i;
            NadjiSumu(suma+i*x[PoslednjaNovcanica+1],PoslednjaNovcanica+1);
         end
   else if suma=TrazenaSuma then
      begin
         write(z[1],'*',x[1]);
         for i:=2 to n do
            write('+',z[i],'*',x[i]);
         writeln('=',TrazenaSuma);
      end;
end;

Na pocetku samo pozoves NadjiSumu(0,0), a u TrazenaSuma sacuvas koja se suma trazi.
 
Poslednja izmena:
Sta te konkretno zanima? Ako mislis npr na onaj alat tipa olovka ili kako se vec zove, dovoljno je da napravis proceduru koja reaguje na on mouse move ili tako nesto i pamteci prethodnu poziciju misa povlacis liniju od prethodne do trenutne pozicije ako je pritisnut levi klik. To da li je pritisnut mozes da proveris tako sto menjas vrednost neke boolean promenljive na on mouse down i on mouse up ako je u pitanju levi klik.
 
Sta te konkretno zanima? Ako mislis npr na onaj alat tipa olovka ili kako se vec zove, dovoljno je da napravis proceduru koja reaguje na on mouse move ili tako nesto i pamteci prethodnu poziciju misa povlacis liniju od prethodne do trenutne pozicije ako je pritisnut levi klik. To da li je pritisnut mozes da proveris tako sto menjas vrednost neke boolean promenljive na on mouse down i on mouse up ako je u pitanju levi klik.

Konkretno sam mislio da imas dugme za liniju na primer, koja posle klika na njega crta liniju sa temenima sa kordinatama sledeca dva klika na formu,nesto slicno kao sto si ti rekao. Problem mi je jedino sto ne znam kako da zapamtim poziciju misa kada kliknem. Jel bi mogao tu nekako da mi pomognes?
 
Dakle umesto
Kod:
for i:=a to b do
   blabla;
moze
Kod:
i:=a-1;
if i<b then
   repeat
      i:=i+1;
      blabla;
   until i=b;


Sto se tice case i if, mislim da moze iskljucivo ako je uslov u if-u jednakost promenljive i konstante tipa integer ili char i to bi izgledalo ovako:
Umesto
Kod:
if prom=konst then
   blabla 
else
   blabla2;
bi islo
Kod:
case prom of
   konst: blabla
else
   blabla2;
end;
ako se ne varam. U ostalim slucajevima ne znam kako bi islo.
 
Prvo treba da shvatis sta se trazi i matematicki to formulises, onda je veoma lako napisati kod. Dakle, ako je perioda 1, onda je svejedno da li je u pitanju npr. f(0.54) ili f(616.54) pa mozes odbaciti sve ono levo od zareza i uzeti u obzir samo ono desno. To radis funkcijom frac koja ti vraca samo deo iza zareza, pa je npr. frac(3.12)=0.12.

Sad treba da podelis tu funkciju na 3 dela posto se sa grafika jasno vidi da je cine 3 razlicite funkcije(ili 2 ako se pomeri perioda, ali recimo da posmatramo deo od 0 do 1). Prva sadrzi tacke (0,0) i (1/4,1/4) i oblika je f(x)=x, sto mozes proveriti ako resis sitem 0=0k+n i 1/4=1/4k+n, iako je prilicno ocigledno sa grafika. Druga sadrzi (1/4,1/4) i (3/4,-1/4) i na isti nacin mozes utvrditi da je ona f(x)=1/2-x. Treca sadrzi (3/4,-1/4) i (1,0) i ona je f(x)=-1+x.

Kod:
program funkcija;
var
   x,f:real;
begin
   write('Unesite x: ');
   readln(x);
   x:=frac(x);
   if x<0.25 then
      f:=x;
   else if x<0.75 then
      f:=0.5-x;
   else
      f:=-1+x;
   writeln('f(x)=',f);
end.
 
Kod:
program horoskop;
var
   d,m:integer;
begin
   write('Unesite redni broj meseca: ');
   readln(m);
   write('Unesite redni broj dana u mesecu: ');
   readln(d);
   if ((m=3) and (d>=21)) or ((m=4) and (d<=20)) then
      writeln('Na dan ',d,'.',m,'. su rodjeni ljudi u znaku ovan.')
   else if ((m=4) and (d>=21)) or ((m=5) and (d<=20)) then
      writeln('Na dan ',d,'.',m,'. su rodjeni ljudi u znaku bik.')
   else if ((m=5) and (d>=21)) or ((m=6) and (d<=20)) then
      writeln('Na dan ',d,'.',m,'. su rodjeni ljudi u znaku blizanci.')
   else if ((m=6) and (d>=21)) or ((m=7) and (d<=21)) then
      writeln('Na dan ',d,'.',m,'. su rodjeni ljudi u znaku rak.')
   else if ((m=7) and (d>=22)) or ((m=8) and (d<=22)) then
      writeln('Na dan ',d,'.',m,'. su rodjeni ljudi u znaku lav.')
   else if ((m=8) and (d>=23)) or ((m=9) and (d<=22)) then
      writeln('Na dan ',d,'.',m,'. su rodjeni ljudi u znaku devica.')
   else if ((m=9) and (d>=23)) or ((m=10) and (d<=23)) then
      writeln('Na dan ',d,'.',m,'. su rodjeni ljudi u znaku vaga.')
   else if ((m=10) and (d>=24)) or ((m=11) and (d<=22)) then
      writeln('Na dan ',d,'.',m,'. su rodjeni ljudi u znaku skorpija.')
   else if ((m=11) and (d>=23)) or ((m=12) and (d<=21)) then
      writeln('Na dan ',d,'.',m,'. su rodjeni ljudi u znaku strelac.')
   else if ((m=12) and (d>=22)) or ((m=1) and (d<=20)) then
      writeln('Na dan ',d,'.',m,'. su rodjeni ljudi u znaku jarac.')
   else if ((m=1) and (d>=21)) or ((m=2) and (d<=19)) then
      writeln('Na dan ',d,'.',m,'. su rodjeni ljudi u znaku vodolija.')
   else
      writeln('Na dan ',d,'.',m,'. su rodjeni ljudi u znaku ribe.');
end.
 

Back
Top