Datoteka: Halflife-sim.gif

Izvor: Hrvatska internetska enciklopedija
Skoči na: orijentacija, traži

Halflife-sim.gif((100 × 188 piksela, veličina datoteke: 17 KB, <a href="/wiki/MIME" title="MIME">MIME</a> tip: image/gif), animacija se ponavlja, 80 okvira, 8,5 s)


Logo Wikimedijinog spremnika Ova je datoteka sa stranica Zajedničkog poslužitelja Zaklade Wikimedije i smiju je rabiti drugi projekti. Opis s njezine stranice s opisom datoteke prikazan je ispod.

Sažetak

Opis
English: Simulation of many identical atoms undergoing radioactive decay, starting with either four atoms (left) or 400 atoms (right). The number at the top indicates how many half-lives have elapsed. Note the law of large numbers: With more atoms, the overall decay is less random. Image made with Mathematica, I am happy to send the source code if you would like to make this image more beautiful, or for any other reason.
Datum
Izvor Vlastito djelo postavljača
Autor Sbyrnes321

Licencija

Public domain Ja, nositelj autorskog prava za ovo djelo, prepuštam ovo djelo u javno vlasništvo. Ovo prepuštanje vrijedi za cijeli svijet.
U nekim državama to nije pravno moguće; ako je tako:
Dajem svima prava da koriste ovo djelo za bilo koju svrhu, bez ikakvih uvjeta, osim ako takvi uvjeti nisu propisani zakonom.
(* Source code written in Mathematica 6.0, by Steve Byrnes, 2010. I release this code into the public domain. *)

SeedRandom[2]

(*Build list of point coordinates and radii*)

BuildCoordList[SqCenterX_, SqCenterY_, SqSide_, PtsPerRow_] := 
  Flatten[Table[{i, j}, {i, SqCenterX - SqSide/2, SqCenterX + SqSide/2, SqSide/(PtsPerRow - 1)},
     {j, SqCenterY - SqSide/2, SqCenterY + SqSide/2, SqSide/(PtsPerRow - 1)}], 1];

coordslist = Join[
   BuildCoordList[3.5, 1, 1.8, 20],
   BuildCoordList[3.5, 3, 1.8, 20],
   BuildCoordList[3.5, 5, 1.8, 20],
   BuildCoordList[3.5, 7, 1.8, 20],
   BuildCoordList[1, 1, .7, 2],
   BuildCoordList[1, 3, .7, 2],
   BuildCoordList[1, 5, .7, 2],
   BuildCoordList[1, 7, .7, 2]];
NumPts = Length[coordslist];
radiuslist = Join[Table[.03, {i, 1, 4*400}], Table[.1, {i, 1, 4*4}]];

(*Draw borders*)

xlist = {0, 2};
leftx = 0;
rightx = 2;
numx = Length[xlist];
ylist = {0, 2, 4, 6, 8};
topy = 0;
boty = 8;
numy = Length[ylist];
lines = {};
For[i = 1, i <= numy, i++, 
  lines = Append[lines, Line[{{leftx, ylist[[i]]}, {rightx, ylist[[i]]}}]]];
For[i = 1, i <= numx, i++, 
  lines = Append[lines, Line[{{xlist[[i]], topy}, {xlist[[i]], boty}}]]];

xlist = {2.5, 4.5};
leftx = 2.5;
rightx = 4.5;
numx = Length[xlist];
ylist = {0, 2, 4, 6, 8};
topy = 0;
boty = 8;
numy = Length[ylist];
For[i = 1, i <= numy, i++, 
  lines = Append[lines, Line[{{leftx, ylist[[i]]}, {rightx, ylist[[i]]}}]]];
For[i = 1, i <= numx, i++, 
  lines = Append[lines, Line[{{xlist[[i]], topy}, {xlist[[i]], boty}}]]];

(*Write numbers:
I want to be able to write a number with one decimal place,
including padding with ".0" when it's an integer.*)

WriteNum[num_] := Block[{rounded}, rounded = N[Floor[num, 0.1]];
    If[FractionalPart[rounded] == 0, ToString[rounded] <> "0", ToString[rounded]]];

(*Randomly choose decay times:
To get an expontial-decay-distributed random number, we pick a number uniformly between 0 and 1.
Take its negative log to get the time that it blows up, which is between 0 and infinity.
But divide by log 2 so that when the time = 1, there's 50% chance of decaying. *)

BlowTime = Table[-Log[RandomReal[]]/Log[2], {i, 1, NumPts}];

(*Draw graphics*)

GraphicsList = {};
NumFrames = 80;
TimePerFrame = .05;

Video = {};
For[frame = 1, frame <= NumFrames, frame++,
  CurrentTime = (frame - 1)*TimePerFrame;
  ImageGraphicsList = lines;
  ImageGraphicsList = 
   Append[ImageGraphicsList, Text[WriteNum[CurrentTime], {.8, 8.5}, {-1, 0}]];
  ImageGraphicsList = 
   Append[ImageGraphicsList, Text[WriteNum[CurrentTime], {3.3, 8.5}, {-1, 0}]];
  For[pt = 1, pt <= NumPts, pt++,
   If[CurrentTime < BlowTime[[pt]], 
    ImageGraphicsList =   Append[ImageGraphicsList, {Blue, Disk[coordslist[[pt]], radiuslist[[pt]]]}]]];
  Video = Append[Video, Graphics[ImageGraphicsList, ImageSize -> 100]];];

(*Pause at start*)
Video = Join[Table[Video[[1]], {i, 1, 5}], Video];

(*Export*)
Export["test.gif", Video, "DisplayDurations" -> {10}, "AnimationRepititions" -> Infinity ]

Opisi

Dodajte kratko objašnjenje što predstavlja ova datoteka

Predmeti prikazani u ovoj datoteci

motiv

28. siječnja 2010

Povijest datoteke

Kliknite na datum/vrijeme kako biste vidjeli datoteku kakva je tada bila.

Datum/VrijemeMinijaturaDimenzijeSuradnikKomentar
sadašnja19:41, 25. ožujak 2010.Minijatura za inačicu od 19:41, 25. ožujak 2010.100 × 188 (17 KB)wikimediacommons>AiyizoOptimized animation, converted to 16 color mode

Na ovu sliku vode poveznice sa sljedećih stranica: