I'm trying to convert an imported colored picture to greyscale.
Here is what i tried so far, but mathematica simple crashes after executing this code, maybe you can find the error, can't recognize what I'm doing wrong:
SetDirectory[NotebookDirectory[]]
testimage = Import["test.jpg"]
matrixpic = getMatrix[testimage]
matrixpic = getMatrix[testimage]
greypic =
Graphics[
Raster[
matrixpic, {{0, 0}, {sizeX[matrixpic], sizeY[matrixpic]}}, {0,
255}, ColorFunction -> (GrayLevel[#[[1]]*0.3 + #[[2]]*0.5 + #[[
3]]*0.2] &)
],
ImageSize -> {sizeX[matrixpic], sizeY[matrixpic]},
AspectRation -> Automatic
]
Show[greypic]
I believe the best way to make this conversion is to use ImageApply and Dot:
img = Import["ExampleData/lena.tif"]
ImageApply[{.3, .5, .2}.# &, img]
Please ask your future questions on the dedicated Mathematica StackExchange site:
This works and is more Mathematica style code.
SetDirectory[NotebookDirectory[]];
img = Import["55th-All-Japan-Kendo-Champ2007-4.jpg"];
colorXform[p_] := p[[1]]*0.3 + p[[2]]*0.5 + p[[3]]*0.2;
newImg = Image[Map[colorXform, ImageData[img], {2}]];
Show[newImg]
Your code can be simplified to
img = Import["ExampleData/lena.tif"];
matrixpic = ImageData[img, DataReversed -> True];
Graphics[Raster[matrixpic,
ColorFunction -> (GrayLevel[{.3, .5, .2}.#] &)]]
This works without errors in Mathematica 8.0.4.
Related
So in order to save some time, I wrote a function to plot a graph with a lot of default settings. I want to add a 0 tick to the Axes, so I added Epilog in the plot. However, the 0 does not seem to show up in the graph, and the Epilog does not seem to be working at all.
LatexTextStyle[text_] :=
Style[text, FontSize -> 18, FontFamily -> "CMU Serif"]
StyledText[text_] := Text[LatexTextStyle[text]]
StyledTextPos[text_, posx_, posy_] :=
Text[LatexTextStyle[text], {posx, posy}]
NPlot[fns_, variable_ : x, xmin_, xmax_, ymin_, ymax_,
pltStyle_ : Default, epilog_ : {}, marginScale_ : 0.12,
fontSize_ : 18, xOffset_ : 10, yOffset_ : 10] := Plot[
fns,
{variable, xmin, xmax},
PlotStyle -> pltStyle,
AspectRatio -> Equal,
PlotRange -> {
{xmin - marginScale*Abs[xmax - xmin],
xmax + marginScale*Abs[xmax - xmin]}, {ymin -
marginScale*Abs[ymax - ymin],
ymax + marginScale*Abs[ymax - ymin]}
},
BaseStyle -> {FontFamily -> "CMU Serif", FontSize -> fontSize},
AxesStyle -> Arrowheads[{0.0, 0.05}],
Epilog -> {
StyledTextPos["0", -xOffset, -yOffset]
}
]
NPlot[fns = x^2 + 2 x + 1, xmin = -10, xmax = 10, ymin = -5,
ymax = 15]
Here is the graph that I got:
When I tried other Epilog inputs, nothing appeared to be showing up.
Your offset defaults are positioning the 0 at {-10, -10}, below the vertical plot range.
These defaults position the 0 correctly:
NPlot[ ... , xOffset_ : 0.6, yOffset_ : 1] := etc.
Carriage returns and certain spaces seem to disappear when pasting in Mma (v. 11). For example, when I cut the following text in word (formatted as such):
xmin = 0; xmax = 1;(*x-axis domain*)
ymin = 0; ymax = 1;(*y-axis domain*)
zmin = 0; zmax = 1;(*z-axis domain*)
E1 = x > 0 && y > 0 && z > 0 && x + y + z < 1;(*domain of solid region E1*)
RegionPlot3D[E1, {x,xmin, xmax}, {y, ymin, ymax}, {z, zmin, zmax},
PlotPoints -> 50,
AxesLabel -> {"x", "y", "z"},
PlotLabel -> "Solid Region E",
ImageSize -> Small]
It comes out like this which is not ideal:
xmin = 0;
xmax = 1;
(*x-axis domain*)ymin = 0;
ymax = 1;
(*y-axis domain*)zmin = 0;
zmax = 1;
(*z-axis domain*)E1 = x > 0 && y > 0 && z > 0 && x + y + z < 1;
(*domain of solid region E1*)
RegionPlot3D[E1, {x,xmin, xmax}, {y, ymin, ymax}, {z, zmin, zmax},PlotPoints -> 50,
AxesLabel -> {"x", "y", "z"},PlotLabel -> "Solid Region E",ImageSize -> Small]
Is there a way to maintain returns and spaces when copying and pasting across programs. Please advise.
Thanks, K
Not particularly straightforward:
Make an empty cell, select it. Go to menu: Format > Style > Program. Paste your code into the cell, select the cell and convert the style back: Format > Style > Input.
Better just to format your how-to document in such a way that it pastes into Mathematica without changing.
Scrape your text in Word and put it in your clipboard
Start Mathematica
Left click inside the notebook
Type an x (or any other character)
Right click the cell bracket on the right side of the notebook enclosing the x
Gently slide the mouse down to Style and then over to left click Text
Scrape over the x to highlight it
Paste your clipboard into Mathematica replacing the x
Right click the cell bracket on the right side of the notebook enclosing the expression
Gently slide the mouse down to Style and then over to left click Input
and your expression will be in Mathematica while preserving your returns and spaces.
I am going to have a n-dimensional function and I would like to able plot 2D planes for the rest of the variables fixed to a number. For example:
u = w^2 y^3 + x^5 z^4 + I z^6 + I z^2 Sin[y + x - 1]+k*Sin[w*pi]
I have 5 variables in here and lets assume I want to fix z w plane and plot with sliding y,z, and k. I have many issues to fix to get what I want to do,
1- As it is the code is not working. I need to figure out to update the limsL and limsR for the sliders. If I remove the doloop and the limits at least I dont get the RED error bar. I need to update those values maybe using a button to get all the data and second button to plot.
2- But even with default limits for sliders [0,1] I do not get a plot. The values are updated at the interface. Under varying variables but does not effect the u function. And actually I prefer variables stay as z,y,x etc and not to get numerical values.
Manipulate[DynamicModule[{u =
z Sin[\[Pi] x] + Cos[\[Pi] y] + y^6 Cos[2 \[Pi] y], vars = {x, y, z}, varlims = {{1, 2}, {3, 4}, {5, 6}}, poi = {x, y},
svars = {z, r}, data = Table[RandomReal[], {20}]}, Column[{Style["Ploter", "Function"],
Row[{"Function ", InputField[u]}, Spacer[20]],
Row[{"Variables ", InputField[Dynamic[vars]]}],
Row[{"Variable limits ", InputField[Dynamic[varlims]]}],
Row[{"Plane of interest", InputField[Dynamic[poi]]}],
Row[{"Varying variables", InputField[Dynamic[svars]]}],
Plotslices[u, vars, varlims, poi, svars, size],
Dynamic[
countersvar = Dimensions[svars][[1]];
limsL = ConstantArray[0, countersvar];
limsR = ConstantArray[0, countersvar];
Do[
v = svars[[i]];
posv = Position[vars, v][[1]];
lv = varlims[[posv, 1]][[1]];
rv = varlims[[posv, 2]][[1]];
limsL[[i]] = lv;
limsR[[i]] = rv;
, {i, countersvar}];
Grid[
Table[With[{i = i}, {svars[[i]],
Slider[Dynamic[svars[[i]], {limsL[[1]], limsR[[i]]}]],
Dynamic[svars[[i]]]}], {i, Dimensions[svars][[1]]}]]]
}]], {size, {Small, Medium, Full}}, ControlPlacement -> Bottom,ContinuousAction -> False, Initialization :> (
Plotslices[u_, vars_, varlims_, poi_, svars_, size_] :=
Module[{v1, v2, lv1, lv2, rv1, rv2, posv1, posv2},
v1 = poi[[1]];
v2 = poi[[2]];
posv1 = Position[vars, v1][[1]];
posv2 = Position[vars, v2][[1]];
lv1 = varlims[[posv1, 1]][[1]];
lv2 = varlims[[posv2, 1]][[1]];
rv1 = varlims[[posv1, 2]][[1]];
rv2 = varlims[[posv2, 2]][[1]];
psl =
Plot3D[u, {v1, lv1, rv1}, {v2, lv2, rv2},
PerformanceGoal -> "Quality", Mesh -> None,
ColorFunction -> Function[{v1, v2, z}, Hue[z]],
ImageSize -> size];
Return[psl];];
)
]
I am sorry for the formatting . I tried to put it together crtl+K but it did not work.
data = EntityValue[CountryData[], {"Name", "Population"}];
WordCloud[data]
All I get is this:
WordCloud[{{"Afghanistan", Quantity[35623235, "People"]}, {"Albania",
Quantity[3248655, "People"]}, {"Algeria",
Quantity[37473690, "People"]}, {"American Samoa",
Quantity[54719, "People"]}, {"Andorra",
Quantity[85458, "People"]}, {"Angola", .....
And not any graphic
I was able to get a word cloud in version 10.0 by using Heike's code, but I had to remove the part concerning a custom distance function since it slows down this version unbelievably.
data = << "http://pastebin.com/raw/02YJ9Ntx";
range = {Min[data[[All, 2]]], Max[data[[All, 2]]]};
words = Style[#1, FontFamily -> "Times", FontWeight -> Bold,
FontColor ->
Hue[RandomReal[], RandomReal[{.5, 1}], RandomReal[{.5, 1}]],
FontSize -> Rescale[#2, range, {12, 70}]] & ### data;
wordsimg =
ImagePad[#, -3 -
BorderDimensions[#]] & /# (Image[
Graphics[Text[Framed[#, FrameMargins -> 2]]]] & /# words);
wordsimgRot =
ImageRotate[#, RandomReal[2 Pi], Background -> White] & /# wordsimg;
iteration2[img1_, w_] :=
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]][[1]];
Sow[minpos - centre];
diff = ImageDimensions[imdil] - dimw;
padding[pos_] := Transpose[{#, diff - #} &#Round[pos - dimw/2]];
ImagePad[#, (-Min[#] {1, 1}) & /# BorderDimensions[#]] &#
ImageMultiply[padded1, ImagePad[w, padding[minpos], 1]]]
Then you can get two different word clouds, with or without random rotations,
{Fold[iteration2, wordsimgRot[[1]], Rest#wordsimgRot],
Fold[iteration2, wordsimg[[1]], Rest#wordsimg]}
These compare quite well with what you get in version 10.3 with WordCloud[data]
I want to use a pair of sliders to set integer values for two variables nLo and nHi, each of which can individually range from 1 to 100, but subject to the restriction that nHi >= nLo. So I set up a slider for each variable that has a range that depends dynamically on the other variable:
nLo = 1; nHi = 100;
Column[
{
Labeled[Slider[Dynamic[nLo], {1, Dynamic[nHi], 1},
Appearance -> "Labeled"], "nLo", Left
],
Labeled[Slider[Dynamic[nHi], {Dynamic[nLo], 100, 1},
Appearance -> "Labeled"], "nHi", Left
],
Dynamic[{nLo, nHi}]
}
]
The problem is that as soon as I adjust nHi, its value becomes real (displays with a decimal point) rather than integer. I presume that this is because the slider for nHi can't tell that its first range argument Dynamic[nLo] is actually an integer and so it defaults to real values instead. Any suggestions as to how to force nHi to remain integer valued? (Linux Mathematica v8.0.1)
Alternatively you could do something like
nLo = 1; nHi = 100;
Column[{Labeled[
Slider[Dynamic[nLo], {1, Dynamic[nHi], 1},
Appearance -> "Labeled"], "nLo", Left],
Labeled[Slider[
Dynamic[nHi, (nHi = Round[#]) &], {Dynamic[nLo], 100, 1},
Appearance -> "Labeled"], "nHi", Left],
{Dynamic[nLo], Dynamic[nHi]}}]
Either I fail to understand the requirements of the solution, or this code may only function correctly in Mathematica 7.
Interesting problem. This appears to work:
nLo = 1; nHi = 100;
Column[{Labeled[
Slider[Dynamic[nLo], {1, Dynamic[nHi], 1},
Appearance -> "Labeled"], "nLo", Left],
Labeled[Slider[
Dynamic[nHi], {Dynamic[Unevaluated#Round#nLo], 100, 1},
Appearance -> "Labeled"], "nHi", Left],
Dynamic[{nLo, nHi}]}]