Skip to main content
Commonmark migration
Source Link

##Updated version##

Updated version

##Second update##

Second update

##Updated version##

##Second update##

Updated version

Second update

added method for creating a vector plot.
Source Link
Heike
  • 36.2k
  • 3
  • 111
  • 158
iteration2[img1_, w_, fun_: ( Norm[#1 - #2] &)] := Module[{imdil, centre, diff, dimw, padding, padded1, minpos}, dimw = ImageDimensions[w]; padded1 = ImagePad[img1, {dimw[[1]] {1, 1}, dimw[[2]] {1, 1}}, 1]; imdil = Binarize[ImageCorrelate[Binarize[ColorNegate[padded1], 0.05], Dilation[Binarize[ColorNegate[w], .05], 1]]]; centre = ImageDimensions[padded1]/2; minpos = Reverse@Nearest[Position[Reverse[ImageData[imdil]], 0], Reverse[centre], DistanceFunction -> fun][[1]]; Sow[minpos - centre]; (* for creating vector plot *) diff = ImageDimensions[imdil] - dimw; padding[pos_] := Transpose[{#, diff - #} &@Round[pos - dimw/2]]; ImagePad[#, (-Min[#] {1, 1}) & /@ BorderDimensions[#]] &@ ImageMultiply[padded1, ImagePad[w, padding[minpos], 1]]] 

Mathematica graphics

##Second update##

To create a vector graphics of the previous result, we need to save the positions of the words in the image, for example by adding Sow[minpos - centre] to the definition of iteration2 somewhere towards the end of the code and using Reap to reap the results. We also need to keep the rotation angles of the words, so we'll replace wordsimgRot with

angles = RandomReal[2 Pi, Length[wordsimg]]; wordsimgRot = ImageRotate[##, Background -> White] & @@@ Transpose[{wordsimg, angles}]; 

As mentioned before, we use Reap to create the position list

poslist = Reap[img = Fold[iteration2, wordsimgRot[[1]], Rest[wordsimgRot]];][[2, 1]] 

The vector graphics can then be created with

Graphics[MapThread[Text[#1, Offset[#2, {0, 0}], {0, 0}, {Cos[#3], Sin[#3]}] &, {words, Prepend[poslist, {0, 0}], angles}]] 
iteration2[img1_, w_, fun_: ( Norm[#1 - #2] &)] := Module[{imdil, centre, diff, dimw, padding, padded1, minpos}, dimw = ImageDimensions[w]; padded1 = ImagePad[img1, {dimw[[1]] {1, 1}, dimw[[2]] {1, 1}}, 1]; imdil = Binarize[ImageCorrelate[Binarize[ColorNegate[padded1], 0.05], Dilation[Binarize[ColorNegate[w], .05], 1]]]; centre = ImageDimensions[padded1]/2; minpos = Reverse@Nearest[Position[Reverse[ImageData[imdil]], 0], Reverse[centre], DistanceFunction -> fun][[1]]; diff = ImageDimensions[imdil] - dimw; padding[pos_] := Transpose[{#, diff - #} &@Round[pos - dimw/2]]; ImagePad[#, (-Min[#] {1, 1}) & /@ BorderDimensions[#]] &@ ImageMultiply[padded1, ImagePad[w, padding[minpos], 1]]] 

Mathematica graphics

iteration2[img1_, w_, fun_: ( Norm[#1 - #2] &)] := Module[{imdil, centre, diff, dimw, padding, padded1, minpos}, dimw = ImageDimensions[w]; padded1 = ImagePad[img1, {dimw[[1]] {1, 1}, dimw[[2]] {1, 1}}, 1]; imdil = Binarize[ImageCorrelate[Binarize[ColorNegate[padded1], 0.05], Dilation[Binarize[ColorNegate[w], .05], 1]]]; centre = ImageDimensions[padded1]/2; minpos = Reverse@Nearest[Position[Reverse[ImageData[imdil]], 0], Reverse[centre], DistanceFunction -> fun][[1]]; Sow[minpos - centre]; (* for creating vector plot *) diff = ImageDimensions[imdil] - dimw; padding[pos_] := Transpose[{#, diff - #} &@Round[pos - dimw/2]]; ImagePad[#, (-Min[#] {1, 1}) & /@ BorderDimensions[#]] &@ ImageMultiply[padded1, ImagePad[w, padding[minpos], 1]]] 

Mathematica graphics

##Second update##

To create a vector graphics of the previous result, we need to save the positions of the words in the image, for example by adding Sow[minpos - centre] to the definition of iteration2 somewhere towards the end of the code and using Reap to reap the results. We also need to keep the rotation angles of the words, so we'll replace wordsimgRot with

angles = RandomReal[2 Pi, Length[wordsimg]]; wordsimgRot = ImageRotate[##, Background -> White] & @@@ Transpose[{wordsimg, angles}]; 

As mentioned before, we use Reap to create the position list

poslist = Reap[img = Fold[iteration2, wordsimgRot[[1]], Rest[wordsimgRot]];][[2, 1]] 

The vector graphics can then be created with

Graphics[MapThread[Text[#1, Offset[#2, {0, 0}], {0, 0}, {Cos[#3], Sin[#3]}] &, {words, Prepend[poslist, {0, 0}], angles}]] 
Added updated version of the code
Source Link
Heike
  • 36.2k
  • 3
  • 111
  • 158

##Updated version##

The previous code places new words in the image by approximating them with rectangles. This works fine for horizontally or vertically oriented words, but not so well for rotated words or more general shapes. Luckily, the code can be easily modified to deal with this by replacing the MaxFilter with a ImageCorrelate:

iteration2[img1_, w_, fun_: ( Norm[#1 - #2] &)] := Module[{imdil, centre, diff, dimw, padding, padded1, minpos}, dimw = ImageDimensions[w]; padded1 = ImagePad[img1, {dimw[[1]] {1, 1}, dimw[[2]] {1, 1}}, 1]; imdil = Binarize[ImageCorrelate[Binarize[ColorNegate[padded1], 0.05], Dilation[Binarize[ColorNegate[w], .05], 1]]]; centre = ImageDimensions[padded1]/2; minpos = Reverse@Nearest[Position[Reverse[ImageData[imdil]], 0], Reverse[centre], DistanceFunction -> fun][[1]]; diff = ImageDimensions[imdil] - dimw; padding[pos_] := Transpose[{#, diff - #} &@Round[pos - dimw/2]]; ImagePad[#, (-Min[#] {1, 1}) & /@ BorderDimensions[#]] &@ ImageMultiply[padded1, ImagePad[w, padding[minpos], 1]]] 

To test this code we use a list of rotated words. Note that I'm using ImagePad instead of ImageCrop to crop the images. This is because ImageCrop seems to clip the words sometimes.

words = Style[First@#, FontFamily -> "Times", FontColor -> Hue[RandomReal[], RandomReal[{.5, 1}], RandomReal[{.5, 1}]], FontSize -> (Last@Rescale[#, range, {12, 150}])] & /@ tally; wordsimg = ImagePad[#, -3 - BorderDimensions[#]] & /@ (Image[ Graphics[Text[Framed[#, FrameMargins -> 2]]]] & /@ words); wordsimgRot = ImageRotate[#, RandomReal[2 Pi], Background -> White] & /@ wordsimg; 

The iteration loop is as before:

Fold[iteration2, wordsimgRot[[1]], Rest[wordsimgRot]] 

which produces

Mathematica graphics


##Updated version##

The previous code places new words in the image by approximating them with rectangles. This works fine for horizontally or vertically oriented words, but not so well for rotated words or more general shapes. Luckily, the code can be easily modified to deal with this by replacing the MaxFilter with a ImageCorrelate:

iteration2[img1_, w_, fun_: ( Norm[#1 - #2] &)] := Module[{imdil, centre, diff, dimw, padding, padded1, minpos}, dimw = ImageDimensions[w]; padded1 = ImagePad[img1, {dimw[[1]] {1, 1}, dimw[[2]] {1, 1}}, 1]; imdil = Binarize[ImageCorrelate[Binarize[ColorNegate[padded1], 0.05], Dilation[Binarize[ColorNegate[w], .05], 1]]]; centre = ImageDimensions[padded1]/2; minpos = Reverse@Nearest[Position[Reverse[ImageData[imdil]], 0], Reverse[centre], DistanceFunction -> fun][[1]]; diff = ImageDimensions[imdil] - dimw; padding[pos_] := Transpose[{#, diff - #} &@Round[pos - dimw/2]]; ImagePad[#, (-Min[#] {1, 1}) & /@ BorderDimensions[#]] &@ ImageMultiply[padded1, ImagePad[w, padding[minpos], 1]]] 

To test this code we use a list of rotated words. Note that I'm using ImagePad instead of ImageCrop to crop the images. This is because ImageCrop seems to clip the words sometimes.

words = Style[First@#, FontFamily -> "Times", FontColor -> Hue[RandomReal[], RandomReal[{.5, 1}], RandomReal[{.5, 1}]], FontSize -> (Last@Rescale[#, range, {12, 150}])] & /@ tally; wordsimg = ImagePad[#, -3 - BorderDimensions[#]] & /@ (Image[ Graphics[Text[Framed[#, FrameMargins -> 2]]]] & /@ words); wordsimgRot = ImageRotate[#, RandomReal[2 Pi], Background -> White] & /@ wordsimg; 

The iteration loop is as before:

Fold[iteration2, wordsimgRot[[1]], Rest[wordsimgRot]] 

which produces

Mathematica graphics

fixed error in code
Source Link
Heike
  • 36.2k
  • 3
  • 111
  • 158
Loading
Source Link
Heike
  • 36.2k
  • 3
  • 111
  • 158
Loading