Uloha v pascale – Pascal – Fórum – Programujte.com

Prosím o pomoc s touto úlohou. Ovocinár má k dispozícii sud . Obsah tohto suda chce bezozbytku rozliať do ďalších súdkov tak, aby súdok bol buď naplnený doplna, alebo aby nebol použitý vôbec. Ovocinár môže mať k dispozícii viac súdkov toho istého objemu.
Úloha 1: Vypočítajte programom a zobrazte na obrazovke všetky možné riešenia (kombinácie), ako je možné pôvodný objem sudu bezozbytku rozliať do ďalších súdkov.
Úloha 2: Vypočítajte programom a zobrazte na obrazovke optimálne riešenie (alebo riešenia), v ktorom (ktorých) je použitých najmenší počet súdkov.

Konkrétne zadanie
Počet litrov vína k dispozícií: 36
Počet rôznych druhov sudov: 6
Jednotlivé sudy k dispozícii: 2x 5-litrový sud , 3x 9-litrový sud , 1x 15-litrový sud , 1x 21-litrový sud , 1x 26-litrový sud , 2x 31-litrový sud
Dakujem

Nevim jestli ti to pomůže ale do školy sem dělal něco podobnýho ale v pythonu ! nechce se mi to přepisovat do pascalu . Snad ti to pomůže:

def plat(kc): # definuje fci plat

    a=[5000,2000,1000,500,200,100,50,20,10,5,2,1] # pole moznych hodnot bankovek

    for i in range(12): # cykl for pro pocet banovek

        if(kc/a[i]>0):

            print(str(kc/a[i])+'x'+str(a[i])+' korunových bankovek')

        kc-=(kc/a[i])*a[i]

kolik=input('Zadej plat: ')

plat(kolik)

raw_input('')

ahoj,
Ja mam taky problém s ukolem v pacalu a nevim jak s nim,jestli by jste mohl někdo pomoci?

Uvažujme následující reprezentaci polynomu:



const MaxStupen = 20;

type Poly = array[0..MaxStupen] of real;

{v poli jsou uloženy koeficienty polynomu,

index = exponent příslušného členu}

var A: Poly;

StA: byte; {stupeň polynomu A}



Napište procedury pro následující operace s polynomy:

a) součet dvou polynomů

b) součin dvou polynomů

c) vstup polynomu (zadání stupně a koeficientů z klávesnice)

d) výstup polynomu (výpis na obrazovku v rozumně čitelném tvaru, např. 3x^2–5x+1 )

Procedury by mohly mít tyto hlavičky:



procedure Soucet(A, B: Poly; StA, StB: byte;

var C: Poly, var StC: byte);

procedure Soucin(A, B: Poly; StA, StB: byte;

var C: Poly, var StC: byte);

procedure Vstup(var A: Poly; var StA: byte);

procedure Vystup(A: Poly; StA: byte);

To Jenicek :

Vstup: Readln ve for-cyklu. Prostě načítáš jednotlivé koeficienty (s příslušnou omáčkou pro uživatele ve stylu "zadejte koeficient pro [kolikátou] mocninu x" apod.); bude jich o 1 víc než jaký je zadaný stupeň polynomu. Neměl by být problém. Zbylé koeficienty až do konce pole vynuluj.

Výstup: Podobné, ale obráceně. Podle stupně polynomu vypisuješ jednotlivé nenulové koeficienty a za každým doplníš 'x^', aktuální index, u kterého jsi, a plus.

Součet: Sčítáš koeficienty na stejných indexech a součty ukládáš na tytéž pozice do výsledného polynomu. Jako hodnotu stupen ber větší ze stupňů obou sčítaných polynomů.

Součin: Musíš vynásobit každý s každým. Nejdřív výsledný polynom vynuluj. Potom do bude to práce pro dvojitý for-cyklus:

for i:=0 to stA do for j:=0 to stB do c[i+j]:=c[i+j]+a[i]*b[j];

To Katherin :

Překlad do pascalštiny:

const a:array[1..12] of word = (5000,2000,1000,500,200,100,50,20,10,5,2,1);



procedure plat(kc);

var i:byte;

Begin

for i:=1 to 12 do

  begin

  if kc div a[i]>0 then writeln(kc div a[i],' ',a[i],'korunových bankovek')

  kc:=kc mod a[i];

  end;

End;



var kolik:longint;



BEGIN

write('Zadej plat: ');

readln(kolik);

plat(kolik);

readln;

END.

To Mircosoft :
mohl by jsi mi to taky prepsat do pascalstiny! ja se tady s tim tyram uz od rana a porad mi neco nejede!! :smile11:
DIK :smile1:

To nejtěžší (součin polynomů) jsem ti napsal, zbytek snad zvládneš, ne? :-)

No dobře, tady je další nápověda (druhá nejsložitější věc):

procedure Vystup(A: Poly; StA: byte);

var i:byte;

Begin

for i:=sta downto 0 do {downto proto, ze vypisujeme od nejvyssich mocnin k nejnizsim}

  if a[i]<>0 then {pokud je tenhle koeficient nenulovy}

    begin

    if (i<sta)and(a[i]>0) then write('+'); {pokud neni na zacatku a je kladny, napiseme pred nej plus (minus se u zapornych cisel vypisuje automaticky)}

    write(a[i],'x^',i); {vypiseme ten koeficient, "x na" a na kolikatou, tj. index v poli}

    end;

writeln; {konec radku, pro prehlednost}

End;

To Mircosoft :
ahoj, HELE fakt nevim,porad mi to nejak nejede,pac se to tedka ucim poprve! mohl by jsi mi to napsat cely?
abych si to mohl dat i do hlavy dik moc!: :smile1:

To Jenicek :
Hoď sem to, co už máš hotové, a já ti řeknu, proč ti to nejede a co máš opravit, aby to jelo. OK?

To Mircosoft :
ahoj dobry tam to jsem dal do hromady po nekolika zkouseni ale mam dalsi problem mam udelat
Program ktery udela pocatecni naplnení pole daty a vypis vysledku a aby podle své volby naplnit pole bud daty ctenymi ze vstupu, nebo daty náhodne vygenerovanými. Počet čísel N si muze uzivatel zvolit.

nedal by jsi mi nejaky rady??

To Jenicek :

takhle nějak to bude vypadat když si má uživatel vybrat kolik náhodných čísel má být vypsáno... když si je bude chtít zadávat sám tak to je podobný akorát upravíš vstup v tom cyklu....

uses crt;

var n=20;

type pole=array[1..n] of integer;



var cisla:pole;

    i:integer;

    barvy:word;



begin

  write('Počet prvků: ');

  readln (n);

  clrscr;

  randomize;



  for i:=1 to n do begin

    cisla[i]:=random(100);

    write(cisla[i]:4);

  end;



  repeat until keypressed;

end.

sorry byla tam drobná chybka....

takhle:

uses crt; 

var n:integer; 

type pole=array[1..n] of integer; 



var cisla:pole; 

    i:integer; 

    barvy:word; 



begin 

  write('Počet prvků: '); 

  readln (n); 

  clrscr; 

  randomize; 



  for i:=1 to n do begin 

    cisla[i]:=random(100); 

    write(cisla[i]:4); 

  end; 



  repeat until keypressed; 

end.

To Jenicek :
A nechtěl bys radši nějaký návod o základech Pascalu obecně? http://mircosoft.ic.cz/texty/ZAKLADY.TXT

moc se omlouvam za svou blbost :-S psal sem to z hlavy a když se to otestoval našel sem další chybu....

uses crt; 

type pole=array[1..32000] of integer;



var cisla:pole; 

    i:integer; 

    n:integer;  



begin 

  write('Pocet prvku: '); 

  readln (n); 

  clrscr; 

  randomize; 



  for i:=1 to n do

  begin

    cisla[i]:=random(100); 

    write(cisla[i]:4); 

  end; 

  repeat until keypressed; 

end.

Potřeboval bych poradit :smile11: , su uplnej začátečník (pomáhá mi tato stránka – kurz pascalu) :smile2: .
Zdroják, kterej je přiloženej mi háže při kompilaci chybu : (50,9)...";" expected but "ELSE" found :smile20:
Budou tam nejspíš i další chyby, ale protože nejsem schopnej tuto odstranit, dál jsem se nedostal. :smile10:
Všem moc dík za odpověď. :smile1:

Chybí ti end za příkazem case.

Katherin napsal:
Prosím o pomoc s touto úlohou. Ovocinár má k dispozícii sud . Obsah tohto suda chce bezozbytku rozliať do ďalších súdkov tak, aby súdok bol buď naplnený doplna, alebo aby nebol použitý vôbec. Ovocinár môže mať k dispozícii viac súdkov toho istého objemu.
Úloha 1: Vypočítajte programom a zobrazte na obrazovke všetky možné riešenia (kombinácie), ako je možné pôvodný objem sudu bezozbytku rozliať do ďalších súdkov.
Úloha 2: Vypočítajte programom a zobrazte na obrazovke optimálne riešenie (alebo riešenia), v ktorom (ktorých) je použitých najmenší počet súdkov.

Konkrétne zadanie
Počet litrov vína k dispozícií: 36
Počet rôznych druhov sudov: 6
Jednotlivé sudy k dispozícii: 2x 5-litrový sud , 3x 9-litrový sud , 1x 15-litrový sud , 1x 21-litrový sud , 1x 26-litrový sud , 2x 31-litrový sud
Dakujem

Nechci bejt hnidopich, ale jen tím end to asi nebude.... Ne že by tam nechybělo, ale i po přidání mi to háže stejnou chybu (51;9 ";" expected..."else" found) :-(
Připojuji opravený zdroj.

Ps.: Nic proti Microsoft, fakt ti moc děkuju za námahu, ale když to stále nefunguje.....

To 0-ndr-4 : mrknu se ti na to ale máš (podle mě) fakt hroznou upravu... temeř se v tom nevyznam... pokus se vyvyrovat použití label a goto.... misto toho třeba repeat cyklus... nejlepší by bylo to celý překopat ale to se ti asi chtít nebude... mno jak řikam mrknu se ti na to a pak napišu ;)

tak tady to máš... chybělo ti tam eště jedno end a když píšeš:

if podminka then

			begin

			prikazy;

			end       //tak tady neni středník! 

		else

			begin

			prikazy;

			end;     // je totiž až tady :)



//jinak když je to takhle



if podminka then

			begin

			prikazy;

			end;    //tak je už tady ale pak už nenásleduje else....

    Program zabava;

uses crt;

label skok,hadanka;

var a,b:real;

    funkce,odpoved,matika,konec:char;



begin

        clrscr;

        writeln;

        writeln('Vitej u pouzivani tohoto zabavneho programu!');

        writeln('Na zacatek si vyber:');

        skok:

        writeln('               a) hadanka');

        writeln('               b) pocitani');

        writeln;

        readln(funkce);

        if (funkce='A') or (funkce='a') or (funkce='H') or (funkce='h')

        then begin

                hadanka:

                clrscr;

                writeln;

                writeln('Jisty clovek si nedavno koupil 2 letadla, ale pozdeji');

                writeln('zjistil, ze mu nevyhovuji. Prodal je kazde za 600 000 korun,');

                writeln('pricemz na jednom prodelal 20% a na druhem 20% ziskal.');

                writeln('Tento clovek na tomto obchodu:');

                writeln('               a) vydelal');

                writeln('               b) prodelal');

                writeln('               c) ani jedno');

                writeln;

                readln(odpoved);

                writeln;

                case odpoved of

                        'A','a','+','v','V': begin

                                                write('Ne, toto neni spravna odpoved');

                                                readln;

                                                goto hadanka;

                                             end;

                        'B','b','-','p','P' : write('Ano, vyborne, respect!');

                        'C','c','0','n','N' : begin

                                                write('No, kdys se to tak veme....20+20...NEE :/)');

                                                readln;

                                                goto hadanka;

                                              end;

                         else begin

                                write('Nespravne zadani, musis zadat a,b nebo c');

                                readln;

                                goto hadanka;

                              end;

                 end;

         end

        else begin

                clrscr;

                writeln('Nejdrive zadej dve cisla a potom vyber akci.');

                writeln;

                writeln('Zadej prvni cislo a potvrd entrem.');

                readln(a);

                writeln('Zadej druhe cislo a potvrd entrem.');

                readln(b);

                writeln('Chces:');

                writeln('     a) scitat (+)');

                writeln('     b) odcitat (-)');

                writeln('     c) nasobit (?)');

                writeln('     d) delit (ö)');

                writeln;

                readln(matika);

                clrscr;

                case odpoved of

                        'A','a','+':writeln(a,' + ',b,' = ',a+b);

                        'B','b','-':writeln(a,' - ',b,' = ',a-b);

                        'C','c','x','?':writeln(a,' ? ',b,' = ',a*b);

                        'D','d','/','ö':writeln(a,' ö ',b,' = ',a/b);

                     else writeln('! SPATNE ZADANI !');

                end;

                delay(2000);

                writeln('Chces se vratit na zacatek? (A/N)');

                readln(konec);

                if (konec='A') OR (konec='a') OR (konec='Y') OR (konec='y')

                then begin

                       writeln('Muzete si tedy znovu vybrat');

                       goto skok;

                     end

                else write('Dekuji za pouziti');



                readkey;

                end;

end.

To Katherin (ovocnarovy sudy):

Zkusim to trochu jinak a podrobneji.

Deklarace a definice:

1) Definuj si sudy. Nejjednodussi asi bude pripravit si pole cisel - objemu (v litrech), tedy treba array[0..11] of word. Objemy soudku do nej nahazej jeden za druhym (1 polozka pole = 1 sud). Toto pole si vypln jako konstantu. Dale ho budu nazyvat PoleSudu.

2) Definuj si mnozstvi vina, ktere se ma rozlit - bud ho zapis jako konstantu nebo si ho deklaruj jako promennou (potom ho nechas zadat od uzivatele). Dale LitruCelkem.

3) Definuj si datovou strukturu, do ktere budes ukladat nalezena reseni. Nejlepe pole array[1..hodne] of word, protoze kombinace sudu pujdou elegantne zapsat ve forme cisla (cislo je uvnitr pocitace binarni a jednotlive bity muzeme chapat jako 1 = plny sud, 0 = prazdny sud). Nazveme si to NalezenaReseni. K nemu pak pomocny index, abys vedela, kam zapisovat: IndexReseni - cislo typu treba word.
Take by se to dalo vyridit mnozinami, ale kdyz tech sudu je takhle malo, jsou wordy vyhodnejsi, protoze zaberou mene pameti.

4) Deklaruj si vsechny dalsi pomocne promenne, ktere budes potrebovat: Kombinace, Litru, Bit a dalsi, ktere uvidis v nasledujicim textu. Vsechno cela cisla, treba word.

Program:

1) Inicializuj promenne (vynuluj IndexReseni, pripadne si nech zadat LitruCelkem, pokud ho nemas jako konstantu).

1.5) Vypis objemy soudku. Vzhledem k tomu, ze jsou pevne dane, muzes to osulit:
writeln('1. typ sudku - objem: 5 L, pocet sudkov: 2'); atd.
Jinak by se to delalo cyklem pro kazdy mozny objem, ktery by projel PoleSudu a spocital vsechny sudy s timto objemem a v pripade nenuloveho vysledku by ten objem a pocet vypsal na obrazovku.

2) Nyni prichazi na radu algoritmus hrube sily: vyzkousime veskere mozne kombinace soudku a ty, ktere vyhovuji, si zapamatujeme. Vyuzijeme toho, ze postupnym zvysovanim cisla o 1 se v nem jednotlive bity samy prestavuji tak, ze postupne dostaneme jejich veskere mozne kombinace.

Misto abychom rozlevali vino z velkeho sudu mezi male, udelame to obracene: ruznym zpusobem naplnime soudky, pak je slijeme dohromady a koukame, jestli to dalo presne objem toho velkeho sudu. Pokud ano, je tato kombinace jedno mozne reseni.

for Kombinace:=1 to $0FFF do {obecne takove cislo, ktere se v binarnim tvaru sklada z tolika jednicek, kolik mas ruznych soudku, nyni 12}

 begin {jednotlive bity cisla Kombinace predstavuji jednotlive sudy (plny/prazdny)}

 Litru:=0; {na zacatku ho vynulujeme}

 for Bit:=0 to 11 do {pro kazdy z 12 bitu (cili pro kazdy sud v aktualni kombinaci):}

  if ((Kombinace shr Bit) and 1)=1 {prislusny bit si posuneme (shr) doprava (na nejnizsi pozici) a vsechny ostatni vynulujeme (and 1). Kdyz ten bit je 1, znamena to plny sud, takze: ...}

   then inc(Litru,PoleSudu[bit]); {...k promenne Litru pricteme (inc) objem prislusneho soudku (tento objem si najdeme v poli PoleSudu)}

 if Litru=CelkemLitru {kdyz jsme se touhle kombinaci trefili:}

  then begin

       inc(IndexReseni); {posuneme se na volnou pozici v seznamu reseni...}

       NalezenaReseni[IndexReseni]:=Kombinace; {...a aktualni kombinaci na toto misto ulozime}

       end;

 end;

for i:=1 to IndexReseni do {pro kazde z nalezenych reseni:}

 begin

 write('reseni c. ',i,': (');

 for bit:=0 to 11 do

  begin

  write ((NalezenaReseni[i] shr bit) and 1); {muzeme vypsat rovnou ten bit (0 nebo 1)}

  if bit<11 then write(', '); {za kazdym krome posledniho napiseme carku}

  end;

 writeln(')');

 end;

Nejmensi:=NalezenaReseni[1]; {prvni cislo z tabulky reseni; slo by misto toho dat nejake hodne velke cislo, hlavne kdyz bude vetsi nez celkovy pocet soudku}

for i:=1 to IndexReseni do {pro kazde z nalezenych reseni:}

 begin

 Pocet:=0;

 for bit:=0 to 11 do {pro kazdy bit}

  inc(pocet,(NalezenaReseni[i] shr bit) and 1); {slo by to i ifem - kdyz je bit 1, zvys pocet o 1. Ale jednodussi je to takhle - pricist primo hodnotu toho bitu (0 nebo 1).}

 if pocet<Nejmensi then Nejmensi:=pocet;

 end;

write('Optimalni reseni jsou: ');

for i:=1 to IndexReseni do

 begin

 Pocet:=0;

 for bit:=0 to 11 do inc(pocet,(NalezenaReseni[i] shr bit) and 1);

 if pocet=Nejmensi then {pokud toto reseni je optimalni...}

  begin

  write(i,'.'); {...vypiseme jeho index...}

  if pocet<IndexReseni then write(', '); {...a za kazdym krome posledniho napiseme carku}

  end;

 end;

To Anonymní uživatel : Díky hrozně moc, to s těma středníkama sem netušil
a to s tím label..(podívej se na lekci 6 http://programujte.com/index.php?akce=clanek&cl=2005111604-turbo-pascal-6-lekce)
Jinak s tou úpravou sem se to snažil oddělit úrovněmi, nevím, jak jinak to udělat přehlednější,
ale pro příště se určitě vynasnažím. Určitě pokud víš jak to udělat lépe a přehledně tak se rád poučím, jelikož toho zatím moc neznám.

To Anonymní uživatel : jj.. uprava zaleži na tobě - pokud se ve svich programech chceš vyznat jenom ty... když chceš aby to chápali i jiní tak existuje pár obecně dodržovaných pravidel... o tom bude určitě nekde psáno (google.com) ale vůbec se neboj používat odsazení... a já třeba místo

if podminka

then

begin

blok prikazu;

end

else

begin

blok prikazu;

end;

if podminka then

			begin

				blok prikazu;

			end

		else

			begin

				blok prikazu;

			end;

jo eště k tem středníkum... středníkem se v pascalu oddělují (ukončují) jednotlivé příkazy... tzn jestliže máš příkaz IF tak ho nemužeš ukončit za then protože to else pak k ničemu nepatří a samotný else mít nemužeš tzn nastane chyba... nevim jestli sem to napsal dost srozumitelně... kdyžtak eště zagoogli...

To Anonymní uživatel : Díky, tím odkazem sem ti chtěl ukázat, že to tam je řešený s goto a label a jelikož jsem přibližně na té úrovni(podle toho), tak sem to udělal víceméně podle toho. To že nepředpokládám že budu profesionálně programovat v Pascalu neznamená že nechci umět dělat dobrý kódy. Ty středníky už chápu, dík. To že není programujte.com jediná stránka vím, nejsem aš taková lama, ale ňák sem se tu zabydlel – tzn. učím se tady, pak jdu jinam – zopakuju si a doučím se. Jinak nevím jak to chceš udělat bez label a goto. Možná cykly....
0-ndr-4

To Anonymní uživatel : ne možná cykly ale určitě cykly... přesněji cykly se zjištováním podmínky na konci - repeat cyklus... použití label a GoTo je podle mě prasárna a mělo by se to zakázat.... je to pozustatek z doby basicu....
D3V1L

kdyby ti to nešlo s těma cyklama tak napiš na mha.phone@centrum.cz ;-)

Ahoj mam napsat takovy program :
Textový soubor obsahuje text s dlouhými řádky. Napište program, který vytvoří kopii tohoto souboru tak, že řádky delší než N znaků rozdělí podle potřeby vždy na dva nebo více řádků po nejvýše N znacích (N je konstanta uvedená v programu, např. N=80).
Prosim porad te nejak?

program:

priprav a otevri soubory;

 repeat

 nacti radek;

 ...zpracovani radku...

 until eof(vstupni soubor);

zavri soubory;

while length(Radek)>zadana delka do {dokud je radek delsi nez ma byt}

  begin

  kus:=usek ze zacatku radku (od 1. znaku) o pozadovane delce; {funkce Copy}

  ten usek ze zacatku radku vymaz; {funkce Delete}

  zapis kus do vystupniho souboru; {procedura Writeln}

  end;

zapis Radek do vystupniho souboru; {touhle dobou uz je urcite kratsi nez pozadovane maximum}

prosim te muzes mi ten radek jeste vic rozepsat?? dik
vim ze to bude do 255 znaku takze pohoda

Co takhle mrknout do helpu? (najeď kurzorem nad jméno dané standardní funkce a zmáčkni Ctrl+F1)

copy(Řetězec,Index,Počet) - funkce, která vrací úsek z daného Řetězce dlouhý Počet znaků a začínající na Index-tém znaku (první znak má index 1).
length(Řetězec) - funkce, která vrací délku daného Řetězce (ve znacích).
delete(Řetězec,Index,Počet) - procedura, která vymaže z daného Řetězce úsek dlouhý Počet znaků a začínající na Index-tém znaku (v minulém příspěvku jsem chybně napsal, že to je funkce).
writeln(Soubor,Něco) - procedura, která zapíše do textového souboru Soubor (otevřeného pro zápis) řetězec (nebo jinou proměnnou, hodnotu nebo výraz) Něco.
Budeš potrebovat dvě proměnné typu string. Jednu na načtení celého řádku, do druhé budeš ukládat kousky, které z toho řádku nařežeš (i když by to šlo zapsat tak, že bys tuhle druhou proměnnou nepotřeboval - do souboru se dá zapsat rovnou výsledek funkce Copy).

P.S.: Stejně si to radši překontroluj podle helpu, protože si nejsem úplně jistý, jestli jsem parametry u Copy a Delete napsal ve správném pořadí.

ahojky lidicky potreboval bych nejaky navod na vyreseni ulohy
V textovém souboru jsou uložena celá čísla.Počet všech čísel není předem znám a může být velmi velký (nelze tedy uložit si všechna čísla do pole!). Soubor není nijak uspořádán, hodnoty čísel se v něm mohou jakkoliv opakovat. Napište program, který určí počet různých hodnot obsažených v tomto souboru.


DIk

Prohledej to tady, uz jsem na to jednou odpovidal. :smile10: :smile20:

ahoj,pls potreboval bych pomoct z ukolem. Mam napsat proceduru ktera vypise kolik kladnych a kolik zapornych cisel je v poli a indexy kladnych a zapornych cisel, zatim mam hotove jen procedury na nacteni a tisk pole ale nevim jak mam vypsat ty indexy. např index kladného čísla v poli A[1,3]

Indexy prvku A[1,3] jsou 1 a 3 (a je to dvojrozměrné pole; jednorozměrné by bylo třeba A[3]). Předpokládám, že ses k tomuhle prvku pole dostal cyklem pomocí nějakých indexů (proměnných - čísel): A[i,j], kde i=1 a j=3. Tak prostě vypiš ta čísla i a j.

ja neznam presne index toho prvku mam do pole nacist cisla z klavesnice a pak pomoci procedury vypsat indexy kladnych a zapornych cisel. Zkousel jsem ty prvky kopirovat do druheho pole ale nejak mi to porad nejede.

procedure nacti(var p:Tpole;r,s:integer);

    var i,j:integer;

    begin

         for i:=1 to r do

         for j:=1 to s do

         readln(p[i,j]);

    end;



    procedure tisk(var p:Tpole;r,s:integer);

    var i,j,kladne,zaporne:integer;

    begin

      kladne:=0;

      zaporne:=0;

         for i:=1 to r do

            begin

            for j:=1 to s do

               begin

                write(p[i,j]:3);

                  if p[i,j]>0 then

                  kladne:=kladne+1;

                  if p[i,j]<0 then

                  zaporne:=zaporne+1;

               end;

              writeln;

            end;

            writeln('Pocet kladnych cisel je: ',kladne);

            writeln('Pocet zapornych cisel je: ',zaporne);

    end;

Stačí připsat pár drobných úprav do procedury tisk (vyznačeny tučně):

procedure tisk(var p:Tpole;r,s:integer);

type PoleIndexu=array[1..KolikBudePotreba] of record

                                              i,j:integer;

                                              end;

var i,j,kladne,zaporne:integer;

    IndexyKladnych,IndexyZapornych:poleindexu;

    posledniK,posledniZ:integer;

 procedure UlozKladneIndexy(radek,sloupec:integer);

 Begin

 poslednik:=poslednik+1;

 with indexykladnych[poslednik] do begin

                                  i:=radek;

                                  j:=sloupec;

                                  end;

 End;

 procedure UlozZaporneIndexy(radek,sloupec:integer);

 ...podobně, jenom použij pole IndexyZapornych a proměnnou posledniZ...

Begin {tisk}

kladne:=0;

zaporne:=0;

posledniK:=0;

posledniZ:=0;

for i:=1 to r do

  begin

  for j:=1 to s do

    begin

    write(p[i,j]:3);

    if p[i,j]>0 then begin

                     kladne:=kladne+1;

                     UlozKladneIndexy(i,j);

                     end

     else if p[i,j]<0 then begin

                           zaporne:=zaporne+1;

                           UlozZaporneIndexy(i,j);

                           end;

    writeln;

    end;

writeln('Pocet kladnych cisel je: ',kladne);

writeln('Pocet zapornych cisel je: ',zaporne);

writeln('Kladna cisla jsou na pozicich: ');

for i:=1 to posledniK do write(indexykladnych[i].i,',',indexykladnych[i].j,'; ');

writeln;

writeln('Zaporna cisla jsou na pozicich: ');

for i:=1 to posledniZ do write(indexyzapornych[i].i,',',indexyzapornych[i].j,'; ');

writeln;

End;

diky moc

tak jsem nacetl cisla do souboru ale porad mi nejde vymyslet jak je mam spocitat?

Máš načítat čísla ze souboru a ne do souboru, ne? :-)

Dobře, tady máš přímý odkaz na to vlákno: http://programujte.com/index.php?akce=diskuze&kam=vlakno&tema=6596-pomoc-du

no jo ale ten ucitel to nechce prave do toho pole tak proto nevim jak nato!

Prostě vynech ten krok načtení do pole. Místo toho, abys čísla načetl všechna a pak je jedno po druhém tahal z pole a zpracovával, je zpracovávej rovnou v tom momentě, kdy je načítáš. Na napsání to bude ještě jednodušší než s tím polem.

ok tak ja to zkusim nejak udelat! dik

Mircosoft napsal:b) Upravit vypis vysledku, aby se zobrazoval pocet sudu prislusneho objemu a ne jenom 1/0.

Zdravim,mam na vas velkou prosbu :) ,do stredy mam odevzdat projekt tohoto prikladu a zatim to nemuzu zprovoznit tak,aby to splňovalo pozadavky,tak pls moc by mi pomohlo kdyby mi nekdo poradil,predem diky moc.

Sestavte proceduru pro vytvoření matice řádu k, rovnající se submatici z dané matice - submatice je vymezena indexy i1, j1, k (i1 - počáteční řádkový index, j1 - počáteční sloupcový index v dané matici, k - řád submatice). Proceduru použijte v programu, který načte čtvercovou matici celých čísel, vypíše ji a potom vytvoří a vypíše dvě zadané submatice z načtené matice. Při práci s procedurami nepoužívejte globální proměnné.

To Pavel : Obě matice udělej jako 2D pole čísel (array[1..něco,1..něco] of ...). Submatici vytáhneš pomocí dvojitého for-cyklu:

pro každý prvek vytvářené submatice (indexy i pro řádek a j pro sloupec) dělej:

 vytáhni ze zdrojové matice hodnotu na indexech [lhy+i-1, lhx+j-1]

 ulož ji do submatice na indexy [i,j]

konec;

To Mircosoft :
no ja s tym este neviem moc dobre robit a nechapem niektore veci. mohol by si sem hodit zdrojak toho? (ak to nestoji prilis vela casu :P) dik

diky moc,ja to predtim delal jinak

To Anonymní uživatel : nejdřív sem hoď ten svůj :smile3:

To Mircosoft :
no to je cast zdrojaku co si uverejnoval ty sam, ono to funguje dobre, len potrebujem vedet ako upravit toto

for i:=1 to IndexReseni do {pro kazde z nalezenych reseni:}
begin
write('reseni c. ',i,': (');
for bit:=0 to 11 do
begin
write ((NalezenaReseni[i] shr bit) and 1); {muzeme vypsat rovnou ten bit (0 nebo 1)}
if bit<11 then write(', '); {za kazdym krome posledniho napiseme carku}
end;
writeln(')');
end;

takze mam napriklad sudky 4l, 6l, 8l, 12l, 13l, 18l (z niektoreho objemu mam k dispozicii viac sudkov)
a potrebujem zmenit vypis na nieco co bude vypisovat riesenie v tvare :
Riesenie c. 3: (2, 3, 1, 0, 0, 0) /namiesto napriklad ( 1,1,0,0,1,1,1,0,1,0,0,0) /
kde cisla znamenaju pocet sudkov prislusneho objemu, pricom objem sudkov je uvedeny v zadani
tzn tento vypis znamena 2x 4l sud, 3x 6l sud, 1x 8l sud, a ostatne su nevyuzite.

:smile15:
Deklaruj si tohle:

const PocetVelikostiSudu=4; {kolik mas ruznych objemu soudku, zadej podle skutecnosti}



var soudky:array[1..pocetvelikostisudu] of record

                                           objem:word;

                                           pocet:word;

                                           end;

for i:=1 to IndexReseni do {pro kazde z nalezenych reseni:}

 begin

 {tady vynuluj polozku pocet ve vsech prvcich pole Soudky}

 for bit:=0 to 11 do

   if ((NalezenaReseni[i] shr bit) and 1)=1 {soudek je plny}

     then begin 

          for x:=1 to PocetVelikostiSudu do {projdi pole Soudky}

            if soudky[x].objem=polesudu[bit] {kdyz zjistis, ze tenhle je ten pravy...}

              then begin

                   inc(soudky[x].pocet); {...zapamatuj si to...}

                   break; {...a vyskoc z tohohle cyklu}

                   end;

          end;

 {Teď máš v poli Soudky uloženo, jaký objem je tam kolikrát,

   tak to v nějakém vhodném tvaru vypiš na obrazovku.}

 end; 

To Mircosoft : dik moc ;) pomohol si mi

To Katherin :
pozri na http://tomiboy.host.sk