skal ikke medtages hvis ikke heltal

Du må kunne spare en masse CPU ved at erstatte

for i := StrToInt(FloatToStr(a[0])) downto 0 do begin
a[x] := StrToInt(FloatToStr(a[0]/y));
x := x+1;
y := y-1;
end;

med

for i := trunc(a[0]) downto 0 do begin
a[x] := trunc(a[0]/y);
x := x+1;
y := y-1;
end;

Kan du ikke teste om hel tal går op:

if (a[x]*y) = s[0] then

Trunc kan ikke bare bruges, da den truncere, altså afrunder.

Så 4,98 bliver til 4.

Problemet opstår INDEN den overhoved har smidt tallet ned i a[x].

Hvad giver StrToInt(FloatToStr(4.98)) ?

Hvis du vil runde af til nærmeste i.s.f. altid ned er der en round også

Men iøvrigt tror jeg at jeg ville gribe det helt andeledes an.

Jeg brygger lige på noget kode.

StrToInt(FloatToStr(4.98)) Denne giver en fejl.
Men Trunc(4.98) kan jeg ikke bruge, for så får jeg jo kun heltal, også alle dem jeg ikke skal bruge.

Det er derfor jeg skal have lavet det på en måde så den ikke afrunder, men samtidig undgår decimaltal.

En simpel, ikke synderligt effektiv funktion til perfekte tal er:

function perfekttal(tal: integer): boolean;
var i,sum: integer;
begin
  sum:=0;
  for i:=1 to tal-1 do
    if (tal mod i)=0 then
      sum:=sum+i;
  perfekttal:=(tal=sum);
end;

Op til 10.000 giver den:
6
28
496
8128

Too late.

Det lignede faktisk mit eksempel meget.

Jeg nøjes dog med at lade løkken løbe op til (tal div 2 + 1).

+ 1 fordi jeg var i tvivl om 1 er et perfekt tal.

Jah, eller op til ca. sqrt(tal)  ;)

erikjacobsen -> Det kan præcist det den skal, drop et svar.

vil du ikke prøve at forklare helt præcist hvad det er du gør? For jeg kan ikke helt gennemskue den.

Jeg ved heller ikke lige med 1

Nej tak, jeg samler slet ikke på point.

Hvad vil du have forklaret?

if (tal mod i)=0 then

perfekttal:=(tal=sum);

disse to linier. specielt den sidste

erik>

sqrt kræver lidt mere da sqrt(28) < 14.

Her er min kode:

program perfect;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils;

function IsPerfect(n : integer) : boolean;

var
  na, i, sum : integer;
  a : array [0..10000] of integer;

begin
  na := 0;
  for i := 1 to (n div 2 + 1) do begin
      if (n mod i) = 0 then begin
        a[na] := i;
        inc(na);
      end;
  end;
  sum := 0;
  for i := 0 to (na - 1) do begin
    sum := sum + a[i];
  end;
  IsPerfect := (sum = n);
end;

function IsPerfectOpt(n : integer) : boolean;

var
  sqrtn, na, i, sum : integer;
  a : array [0..10000] of integer;

begin
  sqrtn := trunc(sqrt(n));
  na := 0;
  a[na] := 1;
  inc(na);
  for i := 2 to sqrtn do begin
      if (n mod i) = 0 then begin
        a[na] := i;
        inc(na);
        a[na] := n div i;
        inc(na);
      end;
  end;
  sum := 0;
  for i := 0 to (na - 1) do begin
    sum := sum + a[i];
  end;
  IsPerfectOpt := (sum = n);
end;

var
  i, t1, t2, t3 : integer;

begin
  t1 := GetTickCount;
  for i := 1 to 10000 do begin
    if IsPerfect(i) then begin
      writeln(i);
    end;
  end;
  t2 := GetTickCount;
  for i := 1 to 10000 do begin
    if IsPerfectOpt(i) then begin
      writeln(i);
    end;
  end;
  t3 := GetTickCount;
  writeln(t2-t1,' ',t3-t2);
end.

Hvis "i" går op i "tal", vil "tal mod i" give et 0.
Den sidste er det samme som

  if tal=sum then
    perfekttal=true
  else
    perfekttal=false;

Tænk på at "tal=sum" enten er sandt eller falsk - og at det præcis er hvad
funktionen skal fortælle os. Bare en hurtig måde at skrive det på.

nåh, ja, sqrt er til primtal, men dem kigger vi ikke på her ;)

det er mest det der "mod" hvad er det helt præcist den gør der?

Jeg mener: det giver ingen mening at sammenligne tid på to vidt forskellige algoritmer.
Det er forkert kun at gå op til kvadratroden, men ok at gå op til halvdelen af
tallet. Den men halvdelen bruger man også til primtalstest, selv om det ikke
sparer så meget - derfor min hurtige reaktion...

Hvis du kigger på min IsPerfectOpt funktion så kan man bruge sqrt, hvis
man hapser både i og tal div i.

Og det er meget hurtigere.

Ja, ok. Den havde jeg ikke lige set, men det må så være hurtigere.
Men man skal nok ikke kaste mega-store tal efter den ;)

"mod" er sådan ca "rest ved division med"

hm okay...

erik>

1-1000000 på 18 sekunder på min PC - ikke hurtigt men heller ikke håbløst

jeg satte min til 40.000.000, den har stået i 20 min. nu

og den er ikke færdig.

Eriks eller min IsPerfect eller min IsPerfectOpt ?

Kun den sidste er praktisk brugbar med så mange tal.

Sådan en PC har jeg også haft en gang ;)  Nej, spøg til side, men det går hurtigt
galt når tallene bliver større. Kender du til teorien for perfekte tal? Og hvorfor
er det lige det du får en mandag aften til gå med?

Det er eriks jeg bruger.

Har lige stoppet processen, min computer kunne slet ikke klare det, den må prøve engang jeg ikke er hjemme.

Det med perfekte tal er noget jeg læste i Illustreret Videnskab, så ville jeg da bare lige se om jeg kunne "finde" nogle flere end dem de har nævnt.

Grunden til at jeg får en mandag til at gå med det er at jeg keder mig SINDSYGT meget. Jeg ved slet ikke hvad jeg skal lave når jeg er hjemme. Så jeg får tiden til at gå med at lave unyttige ting.
-Men hvis nogen har nogle idéer til hvad man kan lave, så er foreslag da velkomne.

Ked dig ikke. Søg på google - sjov læsning med gamle grækere og arabare.
En liste over 41 kendte: http://amicable.homepage.dk/perfect.htm
(jeg kender ham, der har siden...)

Nice side ellers, det sidste tal er bare langt.

Ja, det tror jeg ikke vores programmer kunne have fundet ;)
6 er et perfekt tal, og gud siges at have skabt jorden på 6 dage
28 er et perfekt tal, og månen er 28 dage om en rundtur
496 er et perfekt tal, og antal dage på et år er ... eh ... ca. 365 dage ... - øv, det duede ikke.

I meget gamle dage (mis)brugte Jan, fra bemeldte hjemmeside, universitetets computere
til en masse beregninger af denne karakter. Umiddelbart nytteløst, men meget sjovere end at
se reklamer på TV2. Det var også lang tid før nogen synes det var nødvendigt med
mere end een TV-kanal.

Det tog ca. 1 time hos mig at finde 33 mio. tallet med IsPerfectOpt
(bør nok omdøbes til IsPerfectSomeOpt).

Hvis man kan stole på det bit mønster der outlines på den side der linkes til i det
link Erik gav, så kan man optimere rigtigt meget !

program perfect;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils;

function IsPerfect(n : integer) : boolean;

var
  na, i, sum : integer;
  a : array [0..10000] of integer;

begin
  na := 0;
  for i := 1 to (n div 2 + 1) do begin
      if (n mod i) = 0 then begin
        a[na] := i;
        inc(na);
      end;
  end;
  sum := 0;
  for i := 0 to (na - 1) do begin
    sum := sum + a[i];
  end;
  IsPerfect := (sum = n);
end;

function IsPerfectOpt(n : integer) : boolean;

var
  sqrtn, na, i, sum : integer;
  a : array [0..10000] of integer;

begin
  sqrtn := trunc(sqrt(n));
  na := 0;
  a[na] := 1;
  inc(na);
  for i := 2 to sqrtn do begin
      if (n mod i) = 0 then begin
        a[na] := i;
        inc(na);
        a[na] := n div i;
        inc(na);
      end;
  end;
  sum := 0;
  for i := 0 to (na - 1) do begin
    sum := sum + a[i];
  end;
  IsPerfectOpt := (sum = n);
end;

var
  bitfit : array [1..15] of integer;

function IsPerfectMoreOpt(n : integer) : boolean;

var
  i : integer;
  candidate : boolean;

begin
  candidate := false;
  for i := 1 to 15 do begin
      if bitfit[i] = n then candidate := true;
  end;
  if candidate then
      IsPerfectMoreOpt := IsPerfectOpt(n)
  else
      IsPerfectMoreOpt := false;
end;

var
  i, t1, t2, t3, t4 : integer;

begin
  bitfit[1] := 1;
  for i := 2 to 15 do bitfit[i] := (bitfit[i-1] shl 1) + 1;
  for i := 1 to 15 do bitfit[i] := bitfit[i] shl (i - 1);
  t1 := GetTickCount;
  for i := 1 to 10000 do begin
    if IsPerfect(i) then begin
      writeln(i);
    end;
  end;
  t2 := GetTickCount;
  for i := 1 to 10000 do begin
    if IsPerfectOpt(i) then begin
      writeln(i);
    end;
  end;
  t3 := GetTickCount;
  for i := 1 to 10000 do begin
    if IsPerfectMoreOpt(i) then begin
      writeln(i);
    end;
  end;
  t4 := GetTickCount;
  writeln(t2-t1,' ',t3-t2,' ',t4-t3);
end.

hehe...

IsPerfectMoreOpt

kunne teste de første 40 millioner tal på 2 sekunder !

hvor henne i koden retter du så den kan tage så store tal?

Jeg retter bare

for i := 1 to 10000 do begin

til at gå til det jeg vil.

(og udkommenterer det langsomme versioner !)

hmm... jeg har sat min til 35.000.000 men den finder stadig kun 8128

program perfect;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils;

function IsPerfect(n : integer) : boolean;

var
  na, i, sum : integer;
  a : array [0..10000] of integer;

begin
  na := 0;
  for i := 1 to (n div 2 + 1) do begin
      if (n mod i) = 0 then begin
        a[na] := i;
        inc(na);
      end;
  end;
  sum := 0;
  for i := 0 to (na - 1) do begin
    sum := sum + a[i];
  end;
  IsPerfect := (sum = n);
end;

function IsPerfectOpt(n : integer) : boolean;

var
  sqrtn, na, i, sum : integer;
  a : array [0..10000] of integer;

begin
  sqrtn := trunc(sqrt(n));
  na := 0;
  a[na] := 1;
  inc(na);
  for i := 2 to sqrtn do begin
      if (n mod i) = 0 then begin
        a[na] := i;
        inc(na);
        a[na] := n div i;
        inc(na);
      end;
  end;
  sum := 0;
  for i := 0 to (na - 1) do begin
    sum := sum + a[i];
  end;
  IsPerfectOpt := (sum = n);
end;

var
  bitfit : array [1..15] of integer;

function IsPerfectMoreOpt(n : integer) : boolean;

var
  i : integer;
  candidate : boolean;

begin
  candidate := false;
  for i := 1 to 15 do begin
      if bitfit[i] = n then candidate := true;
  end;
  if candidate then
      IsPerfectMoreOpt := IsPerfectOpt(n)
  else
      IsPerfectMoreOpt := false;
end;

var
  i, t1, t2, t3, t4 : integer;

begin
  bitfit[1] := 1;
  for i := 2 to 15 do bitfit[i] := (bitfit[i-1] shl 1) + 1;
  for i := 1 to 15 do bitfit[i] := bitfit[i] shl (i - 1);
  t1 := GetTickCount;
  (*
  for i := 1 to 10000 do begin
    if IsPerfect(i) then begin
      writeln(i);
    end;
  end;
  t2 := GetTickCount;
  for i := 1 to 10000 do begin
    if IsPerfectOpt(i) then begin
      writeln(i);
    end;
  end;
  t3 := GetTickCount;
  for i := 1 to 10000 do begin
    if IsPerfectMoreOpt(i) then begin
      writeln(i);
    end;
  end;
  t4 := GetTickCount;
  writeln(t2-t1,' ',t3-t2,' ',t4-t3);
  *)
  for i := 1 to 100000000 do begin
    if IsPerfectMoreOpt(i) then begin
      writeln(i);
    end;
  end;
end.

D:\IDEProjects\Delphi\Eksperten>perfect
1
6
28
496
8128
33550336

D:\IDEProjects\Delphi\Eksperten>

arne_v -> takker. Nu hvor erik ikke vil have point, dropper du så ikk et svar. Da du jo også har udført så meget arbejde.

ok

Fik du det til at virke hos dig ?

ja det virker nu... Men er selvfølgelig bare stødt på det problem at den må ikke indeholde tal højere end 99.999.999.999.

Den står vel af allerede ved godt 2 milliarder.

Du skal nok ud of finde en bigint package.

Ja det tror jeg. Jeg kiggede nemlig nogle gamle indlæg igennem, hvor der også stod noget om bigint.