Search code examples
wolfram-mathematicamathematica-8

Goal Seek, in Mathematica


For an experiment, we generated in Matlab some images made out of 8 Disks. We constrained, the minimum distance between the disks and between the disks and the frame as well as the location of the Disks Center Of Gravity (COG). Bellow an example of a composition with the COG on the upper lift "third"

FraXYs = {{4.32, 3.23}, {35.68, 26.75}}

stiDisks = {{{8, 11}, 1}, {{10, 17}, 1}, {{16, 24}, 1}, {{25, 22},1}, 
           {{31, 22}, 1}, {{7, 21}, 2}, {{16, 12}, 2}, {{19, 22}, 2}}

Graphics[{White, EdgeForm[Thick],
  Rectangle @@ FraXYs,
  Red, Disk[{14.77, 18.91}, 1],
  Blue, Opacity[.6], EdgeForm[Black],
  Blue, Thickness[0.003],
  Opacity[1],
  Black,
  Disk[#[[1]], #[[2]]] & /@ stiDisks}, ImageSize -> {400, 300}]

enter image description here

I would like to generate those stimuli in Mathematica. Below are the element (features and constraints) I am dealing with. The measures are in Cm. The Center Of Gravity (COG) of the shapes is defined as the area weihtgted location of the disks.

The Features :

Stimuli Frame : {{xMin,xMin},{xMax,yMax}}

FraXYs = {{4.32, 3.23}, {35.68, 26.75}}

5 Small Disks : with radius

rSmall=1

3 Large Disks : with radius

rLarge=2

The Constraints :

Minimum distance between the shapes edges :

minDistSha=1

Minimum distance between the shapes edges and the frame border :

minDistFra=1

Distance of shapes COG from the center :

minDistCogCenter=2

Potentially, I will need to constraint the COG of the disks to be on a certain angle from the center (theta coordinate in a polar system?). So I could select the disks coordinates constraining their COGs to be located every 22.5 degree in a polar coordinate

angleBin=22.5

Is there useful Functions in Mathematica to achieve the selection under constraints aside of Selct.

I would be curious to know if a closed formula to generate 1 composition with a particular COG location is possible.

Indicatively, I will need to get a pool of 1000 compositions. Using the "theta constraints"of 36 degrees, I should extract 10*100 composition with their COG located on the 10 different theta bars at a minimum or fixed distance from the center.

enter image description here

Please tell me if clarifications are needed. Thank You for your attention.


Solution

  • This might get you started. It is a simple rejection method to generate circles at random, throwing away ensembles that do not meet requirements.

    Arguments are the box size, numbers and radii of small and large circles, and a minimum separation. That last is used both for distances to boundary and distances between circles. I double it for the center of gravity to center of frame constraint. Clearly this usage could be generalized by adding more arguments.

    For purposes of assessing how likely this is to find viable ensembles, I print the number of times through the loop. Also I use a Catch/Throw mechanism that is not really necessary (artifact of some experimentation that I did not bother to remove).

    --- edit ---

    The code below has modest changes from what I originally posted. It separates the center of gravity circle as the red one.

    To handle the constraint that it lie at some specified angle, one might generate as below, rotate to put into the correct angular position, and recheck distances from circles to frame boundary. Possibly there is something smarter that will be less likely to give a rejection, while still maintaining uniformity. Actually I'm not at all certain that what I coded gives a uniform distribution from the space of allowable configurations. If it does, the influence of rotating will very likely destroy that property.

    --- end edit ---

    randomConfiguration[{xlo_, ylo_}, {xhi_, yhi_}, nsmall_, nlarge_, 
      rsmall_, rlarge_, minsep_] := Catch[Module[
       {found = False, xsmall, ysmall, xlarge, ylarge, smallsep, largesep,
         smallcircs, largecircs, cog, cen, indx = 0},
       smallsep = {rsmall + minsep, -rsmall - minsep};
       largesep = {rlarge + minsep, -rlarge - minsep};
       cen = {xhi - xlo, yhi - ylo};
       While[! found,
        found = True;
        indx++;
        xsmall = RandomReal[{xlo, xhi} + smallsep, nsmall];
        ysmall = RandomReal[{ylo, yhi} + smallsep, nsmall];
        xlarge = RandomReal[{xlo, xhi} + largesep, nlarge];
        ylarge = RandomReal[{ylo, yhi} + largesep, nlarge];
        smallcircs = Transpose[{xsmall, ysmall}];
        Do[If[
          Norm[smallcircs[[i]] - smallcircs[[j]]] <= 2*rsmall + minsep, 
          found = False; Break[]], {i, nsmall - 1}, {j, i + 1, nsmall}];
        largecircs = Transpose[{xlarge, ylarge}];
        Do[If[
          Norm[largecircs[[i]] - largecircs[[j]]] <= 2*rlarge + minsep, 
          found = False; Break[]], {i, nlarge - 1}, {j, i + 1, nlarge}];
        Do[If[
          Norm[smallcircs[[i]] - largecircs[[j]]] <= 
           rsmall + rlarge + minsep, found = False; Break[]], {i, 
          nsmall}, {j, nlarge}];
        cog = (rsmall^2*Total[smallcircs] + 
            rlarge^2*Total[largecircs])/(nsmall*rsmall^2 + 
            nlarge*rlarge^2);
        If[Norm[cog - cen] <= 2*minsep, found = False;];
        ];
       Print[indx];
       Throw[{{cog, rsmall},Map[{#, rsmall} &, smallcircs], 
         Map[{#, rlarge} &, largecircs]}]
       ]]
    

    Example:

    {smallc, largec} = 
      randomConfiguration[{4.32, 3.23}, {35.68, 26.75}, 5, 3, 1, 2, 1];
    
    13
    
    FraXYs = {{4.32, 3.23}, {35.68, 26.75}};
    
    {cog, smallc, largec} = 
      randomConfiguration[{4.32, 3.23}, {35.68, 26.75}, 5, 3, 1, 2, 1];
    
    Graphics[{White, EdgeForm[Thick], Rectangle @@ FraXYs, Red, 
      Apply[Disk, cog], Blue, Opacity[.6], EdgeForm[Black], Blue, 
      Thickness[0.003], Opacity[1], Black, 
      Disk[#[[1]], #[[2]]] & /@ Join[smallc, largec]}, 
     ImageSize -> {400, 300}]
    

    enter image description here