🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: pl.comp.lang.funkcyjne
Article #959

zupki

#959
From: Czarek
Date: Sat, 17 Oct 2009 12:43
123 lines
3794 bytes
Witam.
Kolega zbiera saszetki z promocyjnych zupek, zadanie jest takie:
W każdej saszetce jest kwota, trzeba znaleźć okrągłą sumę tych kwot nie 
większą niż 10000, czyli może być 1000, 2000, 3000 ...9000,10000 .
Na razie robię to tak:
Wybieram wszystkie możliwe kombinacje ze zbioru danych i sumuję wybrane 
liczby i sprawdzam czy sumy są podzielne przez 1000. Niestety tych liczb 
jest już ponad 30 i czas zaczyna być długi.
Do tej pory zoptymalizowałem trochę w taki sposób, że liczenie sumy jest 
przerywane przy przekroczeniu 10000. Ale to niewiele dało.
Wpadłem na taki pomysł, że można wyliczyć ile najmniejszych liczb ze 
zbioru danych daje sumę większą niż załozona. Można by w taki sposób 
wybierać zestawy liczące np nie więcej niż 7 liczb. Co o tym sądzicie?
Jak prosto to zaprogramować? Niby można za pomocą 6 zagnieżdżonych 
pętli, ale przy dopisaniu liczby może zajść konieczność modyfikacji 
tekstu programu i ponownej kompilacji.
Poniżej działający program w pascalu (jeszcze dla wszystkich możliwych 
zestawów):

--------------------------------------------

program zupki;

{$mode objfpc}{$H+}

uses
   {$IFDEF UNIX}{$IFDEF UseCThreads}
   cthreads,
   {$ENDIF}{$ENDIF}
   Classes
   { you can add units after this };

type dane =record
   liczba : array[1..100] of integer;
   flaga  : array[1..101] of boolean;
   ilosc  : byte;
end;

const
   suma_max=10000;

var
   liczby : dane;
procedure wczytaj(var liczby : dane);
   var
   plik : text;
   s:integer;

begin
   liczby.ilosc :=0;
   assign(plik,'');
   reset(plik);
   while not eof(plik) do
   begin
     inc(liczby.ilosc);
     readln(plik,s);
     liczby.liczba[liczby.ilosc] := s;
     liczby.flaga[liczby.ilosc] := false;
   end;
   writeln;
   write('wczytano  ');
   writeln(liczby.ilosc,'  liczb');
   writeln;
   close(plik);
end;


function zwieksz(var liczby : dane) : boolean;
var
   pozycja : byte;
   przeniesienie : boolean;
begin
     pozycja := 1;
     while liczby.flaga[pozycja] = true do
       begin
         liczby.flaga[pozycja] := false;
         inc (pozycja);
       end;
     liczby.flaga[pozycja] := true;
     if pozycja > liczby.ilosc then
       zwieksz :=false
     else
       zwieksz := true;

end;



procedure suma(liczby : dane);
var
   suma : longint;
      k : byte;
begin
   suma:=0;
   for k:= 1 to liczby.ilosc do
     begin
       if liczby.flaga[k] then suma := suma + liczby.liczba[k];
       if suma >suma_max then break; {przyspiesza prawie 1,5 raza }
     end;
   if ((suma mod 1000) = 0) and (suma <= suma_max) and (suma >0) then
     begin
       for k:=1 to liczby.ilosc do
           if liczby.flaga[k] then write ('+',liczby.liczba[k]);
       writeln('=',suma);

     end;

end;



begin
wczytaj(liczby);
repeat
   suma(liczby);
until not zwieksz(liczby);

end.


-- 
Cezary Grądys
czarekgr@wa.onet.pl
Technical Details
Message-ID: <hbceak$ob$1@atlantis.news.neostrada.pl>
Path: mbox-mo1.pugleaf.net!news-archive.icm.edu.pl!news.rmf.pl!agh.edu.pl!news.agh.edu.pl!news.onet.pl!newsfeed.neostrada.pl!atlantis.news.neostrada.pl!news.neostrada.pl!not-for-mail

Show Full Headers
Complete Article Headers
Path: mbox-mo1.pugleaf.net!news-archive.icm.edu.pl!news.rmf.pl!agh.edu.pl!news.agh.edu.pl!news.onet.pl!newsfeed.neostrada.pl!atlantis.news.neostrada.pl!news.neostrada.pl!not-for-mail
From: Czarek <czarekgr@wa.onet.pl>
Newsgroups: pl.comp.lang.funkcyjne
Subject: zupki
Date: Sat, 17 Oct 2009 14:43:48 +0200
Organization: TP - http://www.tp.pl/
Lines: 124
Message-ID: <hbceak$ob$1@atlantis.news.neostrada.pl>
NNTP-Posting-Host: dpo252.neoplus.adsl.tpnet.pl
Mime-Version: 1.0
X-Trace: atlantis.news.neostrada.pl 1255783572 779 83.24.148.252 (17 Oct 2009 12:46:12 GMT)
X-Complaints-To: usenet@news.neostrada.pl
NNTP-Posting-Date: Sat, 17 Oct 2009 12:46:12 +0000 (UTC)
User-Agent: Thunderbird 2.0.0.23 (X11/20090817)
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit