Community RSS Feed
https://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Wolfram Scienceshowthread.php?s= sorted by activeProblem with the parametrization of a line integra.
https://community.wolfram.com/groups/-/m/t/1570632
Hello everyone. I have parametrized a straight line to go from point A (0,0) to point B (2,3) with two different aproaches. The first, is to make x=2*t and y=3*t and 0<t<1. The second one is to make x=r*cos(ArcTg(2/3)) and y=r*sin(ArcTg(2/3)); however, I obtain results that are different enough to make me think that I am doing something wrong. However, I don't seem to find where the problem lies at.
This is my code for the first method:
varianza= 2;
Integrate[(Sqrt[2^2 + 3^2]*Exp[(-1.)*((2*t)^2 + (3*t)^2)/(2.*varianza)]/(2*Pi*varianza)), {t, 0, 1}]
and the output is 0.139526.
And for the second:
angulo = ArcTan[2, 3];
Integrate[(r*Exp[(-1.)*((Cos[angulo]*r)^2 + (Sin[angulo]*r)^2)/(2.*varianza)]/(2*Pi*varianza)), {r, 0, Sqrt[2^2+3^2]}];
with output: 0.152984.
I cannot find what is wrong with this. Any help is appreciated.
Thanks.Jaime de la Mota2018-12-13T18:16:52Zdelay differential equations
https://community.wolfram.com/groups/-/m/t/1571720
Dear all,
I am solving a PDE such as :
Button["Stop", stop = True]
stop = False;
currentTime = "Initialization";
interval = T;
SetOptions[EvaluationNotebook[],
WindowStatusArea -> Dynamic["t = " <> ToString[CForm[currentTime]]]];
{uif, vif} =
NDSolveValue[{Activate[divsig - divsig0 == inertia + fadh], ci, cid,
WhenEvent[stop, end = t; "StopIntegration"]}, {u,
v}, {x, y} \[Element] mesh, {t, 0, interval}, Method -> {
"PDEDiscretization" -> {"MethodOfLines",
"SpatialDiscretization" -> {"FiniteElement",
"MeshOptions" -> {"MeshOrder" -> 2, "MaxCellMeasure" -> 0.5},
"IntegrationOrder" -> 4}}},
EvaluationMonitor :> (currentTime = t)(* ,AccuracyGoal\[Rule]5*),
MaxStepSize -> 0.5];
Now, the variable 'divsig0' depends on a previous defined variable, 'eaf', which in turn depends itself on the solution of the PDE through 'uif' like this
eaf = Table[
If[pcontour[[i, j]][[1]] +
uif[t, pcontour[[i, j]][[1]], pcontour[[i, j]][[2]]] > pillarscenters[[i, j]][[1]], t/100 , 0], {i,
Dimensions[alpha][[1]]}, {j, Dimensions[alpha][[2]]}];
It seems I should used a Delay Differential Equation according to the documentation, but I have trouble to specify the initial hystory function...could anyone help me?
I can send the whole code if necessary...
Best
RARachele Allena2018-12-15T20:40:40ZHow to determine forces in biological tissues from images?
https://community.wolfram.com/groups/-/m/t/1571507
Forces and pressure play a key role in the development of an organism. These forces that are generated by the cells can act upon other cells in concert to yield dramatic changes in the architecture of a tissue. Forces may cause a tissue to stretch or rotate. Likewise, the internal pressure within the cells may cause the tissue to bulge or contract. Without precise regulation of
forces and pressure by the cells it is not hard to imagine that the developmental processes will be severely impacted. Therefore, biologists and biophysicists who are studying animal development often need a measure of the distribution of forces and pressure in a tissue over time.
There are experimental methods for measuring forces. In "laser ablation" a high-powered laser beam can be used to ablate junction(s) between two or more cells that are under tension. The recoil velocity can be used to determine the magnitude of tension. Imagine cutting a guitar string that is under high tension. Once snapped it will spring back. The process is highly invasive, that is the
junction in query has to be severed, rendering it less useful to study forces in a spatio-temporal manner.
In this post I would like to share with you the notion of inferring forces and pressure in a tissue using images. This technique, now commonly known as "Force Inference" was proposed by Ishihara and Sugimura (Journal of Theoretical Biology, 2012) as well as Brodland (2014). Force Inference allows us to determine forces without having to destroy tissues. And the idea is pretty simple. A cell is delimited by the junctions (edges) enclosing it and an edge can be represented by a line drawn between two vertices. We assume that a tissue at any given moment is in quasi-equilibrium and consequently the forces acting on the vertices sum to zero. Such an assumption makes sense since morphological changes in tissues occur over a long time-scale. The inertial and viscous effects are negligible. The forces acting on a vertex are both due to tension acting along the cell-cell junctions and the internal pressure of the cell.
Here is a Mathematica implementation that uses force balance over all vertices of an epithelia (sheet of cells) to determine the unknown tension and pressure. Note that the forces and pressure determined from this method only yields a relative estimate of the unknowns and not an absolute one. The script is based on the approach proposed by Ishihara.
![enter image description here][1]
![enter image description here][2]
![enter image description here][3]
![enter image description here][4]
**Code** : https://github.com/alihashmiii/Force-Inference
(* ::Package:: *)
(* ::Section:: *)
(*Associated Functions*)
segmentImage[binarizedMask_?ImageQ,opt:"ConnectedComponents"|"Watershed":"Watershed",
threshCellsize_:\[Infinity]]:= Module[{seg,areas,indexMaxarea,maxArea,indsmallareas={},$ind},
seg = Switch[opt,"ConnectedComponents",
(* assuming we input 0 as foreground and 1 as background. ConnectedComponents is a more general segmentation framework *)
MorphologicalComponents[ColorNegate@binarizedMask, CornerNeighbors->False],
"Watershed",(* for epithelial cells *)
WatershedComponents[binarizedMask, CornerNeighbors->False]
];
areas=ComponentMeasurements[seg,"Area"];
{indexMaxarea,maxArea}=First@MaximalBy[areas,Last]/.Rule-> List;
indsmallareas = Keys@Cases[areas,HoldPattern[_-> 1.]];
If[maxArea >= threshCellsize||indsmallareas!= {},
$ind={indexMaxarea}~Join~indsmallareas;
seg=ArrayComponents[seg,Length@areas,Thread[$ind->0]]
];
seg
];
Options[associateVertices]= {"stringentCheck"-> True};
associateVertices[img_,segt_,maskDil_:2,OptionsPattern[]]:= With[{dim =Reverse@ImageDimensions@img,
stringentQ=OptionValue["stringentCheck"]},
Module[{pts,members,vertices,nearest,vertexset,likelymergers,imagegraph,imggraphweight,imggraphpts,vertexpairs,
posVertexMergers,meanVertices,Fn},
pts = ImageValuePositions[MorphologicalTransform[img,{"Fill","SkeletonBranchPoints"}], 1]; (* finding branch points *)
members = ParallelMap[Block[{elems},
elems = Dilation[ReplaceImageValue[ConstantImage[0,Reverse@dim],#->1],1];
DeleteCases[Union@Flatten@ImageData[elems*Image[segt]],0.]
]&,pts];
vertices = Cases[Thread[Round@members-> pts],HoldPattern[pattern:{__}/;Length@pattern >= 2 -> _]];
(* finding vertices with 2 or more neighbouring cells *)
nearest = Nearest[Reverse[vertices, 2]]; (* nearest func for candidate vertices *)
Fn = GroupBy[MapAt[Sort,(#-> nearest[#,{All,3}]&/@Values[vertices]),{All,2}],Last->First,#]&;
Which[Not@stringentQ,
(* merge if candidate vertices are 2 manhattan blocks away. Not a stringent check for merging *)
KeyMap[Union@*Flatten]@Fn[List@*N@*Mean]//Normal,
stringentQ,
(* a better check is to see the pixels separating the vertices are less than 3 blocks *)
vertexset = Fn[Identity];
(* candidates for merging*)
likelymergers = Cases[Normal[vertexset],PatternSequence[{{__Integer}..}-> i:{__List}/;Length[i]>= 2]];
(*defining graph properties of the image *)
imagegraph = MorphologicalGraph@MorphologicalTransform[img,{"Fill"}];
imggraphweight = AssociationThread[(EdgeList[imagegraph]/.UndirectedEdge->List )-> PropertyValue[imagegraph,EdgeWeight]];
imggraphpts = Nearest@Reverse[Thread[VertexList[imagegraph]-> PropertyValue[imagegraph,VertexCoordinates]],2];
(* corresponding nodes on the graph *)
vertexpairs = Union@*Flatten@*imggraphpts/@(Values[likelymergers]);
(* find pairs < than 3 edgeweights away, take a mean of vertices and update the association with mean position *)
posVertexMergers = Position[Thread[Lookup[imggraphweight,vertexpairs]< 3],True];
If[posVertexMergers != {},
meanVertices=MapAt[List@*N@*Mean,likelymergers,Thread[{Flatten@posVertexMergers,2}]];
Scan[(vertexset[#[[1]]]=#[[2]])&,meanVertices]
];
KeyMap[Union@*Flatten]@vertexset//Normal]
]
];
(* ::Section:: *)
(*Force Inference*)
plotMaps[p_,segmentation_,edgeImg_,maxcellLabels_,dimTx_,vertexToCells_,
vertexCoordinatelookup_,edgeLabels_]:=Module[{cellToVertexLabels,cellToAllVertices,ptsEdges,k,v,ord,edgeptAssoc,poly,pts,
mean,ordering,orderpts,tvals,cols,pvals,removecollabels,collabels,pressurecolours},
cellToVertexLabels= Reverse[vertexToCells,2];
cellToAllVertices= GroupBy[Flatten[Thread/@cellToVertexLabels],First-> Last];
(* polygons *)
ptsEdges ={{1,1},Reverse@Dimensions[segmentation],{Last[Dimensions@segmentation],1},{1,First[Dimensions@segmentation]}};
{k,v}={Keys@#,Values[#][[All,2]]}&@ComponentMeasurements[segmentation,{"AdjacentBorderCount","Centroid"},#==2&];
ord=Flatten[Function[x,Position[#,Min[#]]&@Map[EuclideanDistance[#,x]&,ptsEdges]]/@v];
edgeptAssoc=Association[Rule@@@Thread[{k,ptsEdges[[ord]]}]];
poly=(
pts=vertexCoordinatelookup/@cellToAllVertices[#];
If[MemberQ[k,#],AppendTo[pts,edgeptAssoc[#]],pts];
mean=Mean[pts];
ordering=Ordering[ArcTan[Last@#-Last@mean,First@#-First@mean]&/@pts];
orderpts=pts[[ordering]];
Polygon@Append[orderpts,First@orderpts]
)&/@Range[maxcellLabels];
tvals=Rescale@p[[1;;Last@dimTx]];
cols=ColorData["Rainbow"][#]&/@tvals;
Print["Tension map:"];
Print[Graphics[{Thickness[0.005],Riffle[cols,Line/@Values@edgeLabels]}]];
pvals=p[[ Last[dimTx]+1;;]];
removecollabels=Keys@ComponentMeasurements[segmentation,"AdjacentBorders",Length[#]>0&];
collabels=Complement[Range@maxcellLabels,removecollabels];
pressurecolours=ColorData["Rainbow"][#]&/@Rescale[(pvals[[collabels]])];
Print["Pressure map:"];
Print@Show[Graphics@Riffle[pressurecolours,poly[[collabels]]],edgeImg];
]
(* maximize Log-likelihood function *)
maximizeLogLikelihood[spArrayX_,spArrayY_,dimTx_,dimPx_]:= Module[{range=10.0^Range[-1.5,1.5,0.1],sol,spA,spg,spB,n,m,spb,\[Tau],
SMatrix,Q,R,H,h,logL,\[Mu],p},
Print[Style["\nwith maximum likelihood",Bold,18]];
sol=With[{ls=range},
(*spA=SparseArray@(Join[spArrayX,spArrayY]);*)
spA=SparseArray@(Flatten[Transpose[{spArrayX,spArrayY}],1]);
spg=SparseArray@(ConstantArray[1.,Last@dimTx]~Join~ConstantArray[0.,Last@dimPx]);
spB=SparseArray@DiagonalMatrix[spg];
n=First@Dimensions@spA;
m=(Length[#]-Total@#)&@Diagonal[spB\[Transpose].spB];
With[{DimspB=First[Dimensions@spB]},
spb=SparseArray@ConstantArray[0.,First[Dimensions@spA]];
Table[(\[Tau]=Sqrt[\[Mu]];
SMatrix=SparseArray@(Map[Flatten]@Transpose[{Join[spA,\[Tau] spB],Join[spb,\[Tau] spg]},{2,1}]);
{Q,R}=SparseArray/@QRDecomposition[SMatrix];
R=DiagonalMatrix[Sign[Diagonal@R]].R;
H=R[[;;#,;;#]]&@DimspB;
\!\(\*OverscriptBox[\(h\), \(\[RightVector]\)]\)=R[[;;#,#+1]]&@DimspB;
h=R[[#+1,#+1]]&@DimspB;
logL=-(n-m+1)*Log[h^2]+Total[Log[Diagonal[\[Mu] (spB\[Transpose].spB)]["NonzeroValues"]]]-
2*Total[Log[Diagonal[H[[1;;-2,1;;-2]]]["NonzeroValues"]]]
),{\[Mu],ls}]
]
];
Print[ListPlot[{sol,sol},Joined-> {True,False},PlotStyle->{{Red,Thick},{PointSize[0.02],Black}},AxesStyle->{{Black},{Black}},
AxesLabel->{"index \[Mu]","LogLikelihood"},Background->LightBlue]];
\[Mu]=Keys@@MaximalBy[Thread[range-> sol],Values,1];
Print["optimized value of \[Mu]: ",\[Mu]];
\[Tau]=Sqrt[\[Mu]];
With[{DimspB=First[Dimensions@spB]},
SMatrix=SparseArray@(Map[Flatten]@Transpose[{Join[spA,\[Tau] spB],Join[spb,\[Tau] spg]},{2,1}]);
{Q,R}=SparseArray/@QRDecomposition[SMatrix];
R=DiagonalMatrix[Sign[Diagonal@R]].R;
H=R[[;;#,;;#]]&@DimspB;
\!\(\*OverscriptBox[\(h\), \(\[RightVector]\)]\)=R[[;;#,#+1]]&@DimspB;
];
p=PseudoInverse[H].\!\(\*OverscriptBox[\(h\), \(\[RightVector]\)]\); p
];
formAndComputeMatrices[vertexCoordinatelookup_,inds_,colsOrder_,edgenum_,delV_,
vertexToCells_,vertexvertexConn_,maxcellLabels_,filteredvertices_,vertexAssoc_]:=Module[{tx,ty,tensinds,filteredvertexnum,relabelvert,
spArrayTx,spArrayTy,spArrayPx,spArrayPy,spArrayX,spArrayY,$filteredvertices},
{tx,ty}=Transpose[
With[{target=vertexCoordinatelookup[#[[2]]],source=vertexCoordinatelookup[#[[1]]]},
(target-source)/Norm[target-source]
]&/@inds];
Print["Tension coefficients computed: ",Style["\[CheckmarkedBox]",20]];
MapThread[Print[Style["counts of zero coefficients "<>#1,Red], Count[#2,0.]]&,{{"Tx: ","Ty: "},{tx,ty}}];
$filteredvertices=Complement[filteredvertices,delV];
filteredvertexnum=Length@$filteredvertices;
relabelvert=AssociationThread[$filteredvertices-> Range[Length@$filteredvertices]];
tensinds=Thread[{Lookup[relabelvert,Part[inds,All,1]],colsOrder}];
spArrayTx=spArrayTy=SparseArray@ConstantArray[0,{filteredvertexnum,edgenum}];
MapThread[(spArrayTx[[Sequence@@#1]]=#2)&,{tensinds,tx}];
MapThread[(spArrayTy[[Sequence@@#1]]=#2)&,{tensinds,ty}];
spArrayPx=spArrayPy=SparseArray@ConstantArray[0,{filteredvertexnum,maxcellLabels}];
MapThread[Print[Style[#1<> "coefficients stats: ",Blue],Counts@Map[Total@*Unitize,Normal[#2]]]&,
{{"Tx ", "Ty "},{spArrayTx,spArrayTy}}];
Print[Style["Tension coefficients dist: ",Bold],Histogram[{{},Join[spArrayTx["NonzeroValues"],spArrayTy["NonzeroValues"]]},20,
ImageSize->Small]];
Block[{neighbouringCells,bisectionlabels,bisectpts,centroid,orderingT,
vertexcoords,orderptsT,orderIndT,orderCells,kk=0,px,py},
With[{cellToVertexLabelsT= Reverse[vertexToCells,2],
edgeVertexPart=GroupBy[vertexvertexConn~Flatten~1 ,First-> Last]},
With[{cellToAllVerticesT= GroupBy[Flatten[Thread/@cellToVertexLabelsT],First-> Last]},
Do[
neighbouringCells= vertexToCells[[i,2]]; (* for vertex, the neighbouring cell labels *)
bisectionlabels=Intersection[cellToAllVerticesT[#],edgeVertexPart[i]]&/@neighbouringCells ;
If[Length[neighbouringCells]>2 && MatchQ[bisectionlabels,{Repeated[{_,_},{3,\[Infinity]}]}],
(vertexcoords=DeleteDuplicates[vertexCoordinatelookup[#]&/@Flatten@bisectionlabels];
centroid=Mean@vertexcoords;
orderingT=Ordering[ArcTan[Last@#-Last@centroid,First@#-First@centroid]&/@vertexcoords];
orderptsT=vertexcoords[[orderingT]];
orderIndT=Partition[Lookup[vertexAssoc,Append[orderptsT,First@orderptsT]],2,1];
orderCells =
Last@@@Position[(x\[Function] Map[Intersection[x,#]&,orderIndT])/@(cellToAllVerticesT[#]&/@neighbouringCells),x_/;Length[x]==2];
neighbouringCells=neighbouringCells[[orderCells]];
bisectpts=Map[vertexCoordinatelookup,orderIndT,{2}];
{px,py}=Transpose[{(#[[2,2]]-#[[1,2]])/2,-(#[[2,1]]-#[[1,1]])/2}&/@bisectpts];
If[MemberQ[px,0.]||MemberQ[py,0.],kk++];
{px,py})
];
Scan[(spArrayPx[[ Sequence@@#[[1]] ]]=#[[2]])&,Thread[Thread[{relabelvert@i,neighbouringCells}]-> px]];
Scan[(spArrayPy[[ Sequence@@#[[1]] ]]=#[[2]])&,Thread[Thread[{relabelvert@i,neighbouringCells}]-> py]],
{i,$filteredvertices}]
]
];
Print["Pressure coefficients computed: ",Style["\[CheckmarkedBox]",20]];
Print[Style["Pressure coefficients zero: ",Red],kk ];
];
MapThread[Print[Style[#1<> "coefficients stats: ",Blue],Counts@Map[Total@*Unitize,Normal[#2]]]&,
{{"Px ", "Py "},{spArrayPx,spArrayPy}}];
Print[Style["pressure coefficients dist: ",Bold],
Histogram[{{},Join[spArrayPx["NonzeroValues"],spArrayPy["NonzeroValues"]]},ImageSize->Small]];
spArrayX=Join[spArrayTx,spArrayPx,2];
spArrayY=Join[spArrayTy,spArrayPy,2];
{spArrayX,spArrayY,Dimensions[spArrayTx],Dimensions[spArrayPx]}
]
ForceInference[filename_]:=Module[{Img,segmentation,maxcellLabels,cellsToVertices,vertexnum,edges,smalledges,maxedgeLabels,
edgeEndPoints,nearest,nearestedgeEndPoints,edge2pixLabels,pos,oldCoords,vertexAssoc,vertexToCells,filteredvertices,filteredvertexnum,
relabelvert,edgeLabels,edgenum,spArrayTx,spArrayTy,vertexCoordinatelookup,vertexpairs,vertexvertexConn,inds,edgelabelToVert,delV,
vertToedges,edgeImg,colsOrder,p,spArrayX,spArrayY,dimTx,dimPx},
LaunchKernels[];
Img= ColorConvert[Import[filename],"Grayscale"];
Print[Image[Img,ImageSize->Medium]];
segmentation = segmentImage[Img];
Print["Image segmented: ", Style["\[CheckmarkedBox]",20]];
maxcellLabels = Max@Values@ComponentMeasurements[segmentation,"LabelCount"];
cellsToVertices = associateVertices[Binarize@Img,segmentation];
Print["vertices found and associated: ", Style["\[CheckmarkedBox]",20]];
vertexnum=Length@cellsToVertices;
edges=MorphologicalComponents@ImageFilter[If[#[[3,3]] == 1 && Total[#[[2;;-2,2;;-2]],2] == 3, 1, 0]&,Img,2];
(* associate vertices with all edges. for pixel value 1 edge find two nearest pts. for all edges <3, merge the pts together;
make changes to the cellToVertex *)
(* edges to be deleted *)
smalledges=Flatten[Position[Values@ComponentMeasurements[edges,"Count"],1|2]];
maxedgeLabels=Max@edges;
edgeEndPoints=With[{comp=Values@ComponentMeasurements[edges,"Mask"]},
ParallelTable[
If[Total[#] == 1,ImageValuePositions[#,1],
ImageValuePositions[MorphologicalTransform[#,"SkeletonEndPoints"],1]]&@Binarize@Image[comp[[i]]]
,{i,maxedgeLabels}]
];
(* for small edge: if one pixel delete *)
edges=Fold[If[Length@edgeEndPoints[[#2]]==1,#1/.#2 -> 0,#1]&,edges,smalledges];
nearest=Nearest@Flatten[Values[cellsToVertices],1];
nearestedgeEndPoints=Map[Flatten@*nearest,edgeEndPoints,{2}];
(* if edge is two pixels then put average value in the cellsToVertices: *)
edge2pixLabels=Keys@Cases[ComponentMeasurements[edges,"Count"],HoldPattern[_-> 2]];
If[edge2pixLabels!={},
(oldCoords=nearestedgeEndPoints[[#]];
pos=Position[cellsToVertices,#,Infinity]&/@oldCoords;
cellsToVertices=Fold[ReplacePart[#1,#2-> Mean@oldCoords]&,cellsToVertices,pos]
)&/@edge2pixLabels
];
edges=ArrayComponents[edges/.Thread[edge2pixLabels-> 0]];
Print["edges found and associated: ", Style["\[CheckmarkedBox]",20]];
cellsToVertices=Normal@AssociationMap[Reverse,GroupBy[cellsToVertices,Last-> First,Union@*Flatten]];
vertexnum=Length@cellsToVertices;
nearest=Nearest@Flatten[Values@cellsToVertices,1];
edgeEndPoints=Delete[edgeEndPoints,Partition[smalledges,1]];
nearestedgeEndPoints=Map[Flatten@*nearest,edgeEndPoints,{2}];
vertexAssoc= AssociationThread[Flatten[Values@cellsToVertices,1],Range@vertexnum];
vertexToCells=Reverse[MapAt[vertexAssoc[#]&,MapAt[Flatten,cellsToVertices,{All,2}],{All,2}],2];
(* Tension*)
filteredvertices=Keys@Select[<|vertexToCells|>,(Length[#]>2&)];
filteredvertexnum=Length@filteredvertices;
(* till above we have isolated all vertices that share three edges; we can relabel those filtered vertices to be the
rows of the matrix *)
relabelvert=AssociationThread[filteredvertices-> Range[Length@filteredvertices]];
(* all edges are relabeled to have a unique identity *)
edgeLabels=AssociationThread[Range[Length@#]->#]&[nearestedgeEndPoints];
edgenum=Max[Keys@edgeLabels];
vertexCoordinatelookup=AssociationMap[Reverse,vertexAssoc];(* given the vertex label \[Rule] get the coordinates from the
original lookup *)
vertexpairs=Map[vertexAssoc,nearestedgeEndPoints,{2}];
(* edge coordinates to vertex label. take vertices one by one and find all the edges it is a part of. None should be less than 3 *)
vertexvertexConn= ParallelTable[
Cases[vertexpairs,{OrderlessPatternSequence[i,p_]}:> {i,p}],
{i,filteredvertices}];
delV=Cases[vertexvertexConn,{{p_,_},{p_,_}}:> p];
vertexvertexConn=DeleteCases[vertexvertexConn,{_,_}];
inds=Flatten[vertexvertexConn,1];
(* edgelabel \[Rule] vertices *)
edgelabelToVert=Map[vertexAssoc,edgeLabels,{2}];
(*vertices \[Rule] edgelabel *)
vertToedges=Normal@AssociationMap[Reverse,edgelabelToVert];
colsOrder=Flatten[Cases[vertToedges,PatternSequence[{OrderlessPatternSequence@@#}-> p_]:> p,Infinity]&/@inds];
edgeImg=Graphics[{Thickness[0.005],Line@Lookup[vertexCoordinatelookup,edgelabelToVert[#]]&/@colsOrder}];
{spArrayX,spArrayY,dimTx,dimPx} = formAndComputeMatrices[vertexCoordinatelookup,inds,colsOrder,edgenum,delV,vertexToCells,
vertexvertexConn,maxcellLabels,filteredvertices,vertexAssoc];
p = maximizeLogLikelihood[spArrayX,spArrayY,dimTx,dimPx];
plotMaps[p,segmentation,edgeImg,maxcellLabels,dimTx,vertexToCells,vertexCoordinatelookup,edgeLabels];
];
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=im1.png&userId=942204
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=im2.png&userId=942204
[3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=im3.png&userId=942204
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=im4.png&userId=942204Ali Hashmi2018-12-15T17:45:01Z[MAKE] Spikey Commemorative Coins
https://community.wolfram.com/groups/-/m/t/1569688
**Authors : [@Frederick Wu][at0] [@Shenghui Yang][at1]**
![enter image description here][414]
![enter image description here][415]
![enter image description here][1]
![enter image description here][416]
One day my friend ShengHui Yang from Wolfram Alpha approached me and suggested that I could make a physical Wolfram Spikey Coin (not to confuse with [Wolfram Blockchain Token][2] ;-) ), as for [the celebration for the 30th anniversary of Mathematica][3]. As a long-term Mathematica user and coin collector, I challenged myself to design my own commemorative coin for such a special event.
![enter image description here][4]
The iconic [Spikey][5] is a life-long companion of Mathematica since Version 1, coined (no pun intended) in 1988. We come to a time that [Wolfram technologies][6] and different 3D Printing processes happily marry together in 2018.
1. Introduction
------------
Traditional coin casting is [low-relief][11] design. It is the optical orthogonal projection that makes viewers feel the sculpture raised from the background plane and creates a vivid 3D optical illusion with minimum model depth. Usually, the relief depth plane can be set between front plane of the object and the vanishing plane. A low-relief compresses the model in axial direction (perpendicular to the background plane) in the scale ratio ranging from 0.02 to 0.1, a high relief from 0.1 to 0.2, and a super-high-relief greater than 0.3.
![enter image description here][12]
I crafted a Demonstration Projects Applet ([Design Your Own Commemorative Coin][13]) to illustrate some cool coin designs using aforementioned orthogonal projection and 3D geometric scaling method. The user can freely set the view point, the level of relief plane and the scaling ratio.
Here there is a list of geometric objects available in the applet:
subjectList = {"Spikey", "BassGuitar", "Beethoven", "CastleWall",
"Cone", "Cow", "Deimos", "Galleon", "HammerheadShark", "Horse",
"KleinBottle", "MoebiusStrip", "Phobos", "PottedPlant", "Seashell",
"SedanCar", "SpaceShuttle", "StanfordBunny", "Torus", "Tree",
"Triceratops", "Tugboat", "UtahTeapot", "UtahVWBug", "Vase",
"VikingLander", "Wrench", "Zeppelin"};
Here there is a list of materials and colors available. The texture of the metal affects the reflection and color of the coin:
material = {"Pt", "Au", "Ag", "Cu", "Ni", "Ti", "Al", "Zn"};
color = ColorData["Atoms"][#] & /@ material;
materialColor =
Thread[Rule[color,
Row[{#[[1]], " ", #[[2]]}] & /@ Transpose[{material, color}]]];
Extract the 3D body configuration of the Spikey through ExampleData.
modelFun[object_] :=
If[object == "Spikey", PolyhedronData["Spikey", "GraphicsComplex"],
ExampleData[{"Geometry3D", object}, "GraphicsComplex"]];
Create 3D models of coins and add controls to the applet:
![enter image description here][14]
Programming in Wolfram Language provides a simple way to evaluate the accuracy of a relief model against a real 3D model. Think about the test as if you handhold a solid 3D spikey and rotate it so the spikey can coincide with the configuration in the relief above. Meanwhile the scaling effect is how close you hold the spikey to your eye.
What we mean about same configuration is that the grey impression on the left was as if made by the right object punching through the round piece. Like aligning a palm with the impression after a face slap.
![enter image description here][15]
To quantify the scaling effect, run the following code to generate three pieces of graphical information:
region3DRaw = PolyhedronData["Spikey", "Region"];
region3D =
TransformedRegion[region3DRaw, RotationTransform[3, {1, 1, 1}]];
region3DTr =
TransformedRegion[region3D,
ScalingTransform[.2, {0, 0, 1}, {0, 0, 0}]];
- The left graphics is a view of a real 3D spikey object (2D
projection onto our retina).
- The middle one is a relief model from same view point but the model is "squeezed" (moved back and forth) with a certain scaling ratio along
a certain vector. The vector is in the direction of a given view point and center of the object.
- The right image is the image difference between the 3D object and the relief object.
It counts difference pixels in image range.
SetOptions[{Region}, Boxed -> False, ViewPoint -> {0, 2, 10},
BaseStyle -> {Gray, EdgeForm[Thick]},
PlotRange -> {{-2, 2}, {-2, 2}, {-2, 2}}, AspectRatio -> 1,
Lighting -> {"Directional", White}, ImageSize -> 400 {1, 1}];
threeDim = Region[region3D];
reliefDim = Region[region3DTr];
Export["threeDim.png", threeDim];
Export["reliefDim.png", reliefDim];
imageThreeDim = Import["threeDim.png"];
imageRelief = Import["reliefDim.png"];
diff = Binarize@ImageDifference[imageThreeDim, imageRelief];
Grid[{Style[#, 14] & /@ {"real 3D object", "relief model",
"image pixel difference"},
Framed /@ {imageThreeDim, imageRelief, ColorNegate@diff}}]
![enter image description here][16]
Further numerical analysis can be carried out with the code below, shown in the list plot on the left and right contour shown numerically.
On the right graph, for example, we choose a red point on the cross:
- A 3D model compressed at scaling ratio 0.2 and becoming a relief
model.
- An observer views the relief model within a view angle range, deviated
from the center vector less than 10 degrees.
It generates only 3.3% pixel error in boundary. In other words, the relief model used 20% depth of the 3D object to create 96.7% 3D effect.
![enter image description here][17]
2. Design
---------
We have come a long way, but the job is not finished yet. There is small clearance between the spikey and coin body. So I need to fill the gap in geometry.
First, I get the spikey region model, I also rotate the Spikey a little bit to create a non-symmetric pattern for artistic reasons.
SetOptions[{Region}, Boxed -> False, ViewPoint -> Automatic,
BaseStyle -> {Pink, EdgeForm[Thick]},
PlotRange -> All, AspectRatio -> 1, Lighting -> "Neutral",
ImageSize -> 400 {1, 1}];
SpikeyRegion = PolyhedronData["Spikey", "Region"];
SpikeyRegion3D =
TransformedRegion[
TransformedRegion[SpikeyRegion, RotationTransform[E, {E, Pi, E}]],
ScalingTransform[12 {1, 1, 1}, {0, 0, 0}]];
Row[{Column[{"Spikey Top View",
Region[SpikeyRegion3D, ImageSize -> 250 {1, 1},
ViewPoint -> {0, 0, 100}]}, Alignment -> Center],
Column[{"Spikey Bottom View",
Region[SpikeyRegion3D, ImageSize -> 250 {1, 1},
ViewPoint -> {0, 0, -100}]}, Alignment -> Center]}]
![enter image description here][21]
Here I pull each face of the triangle or polygon along the Z direction.
regionData = Table[MeshPrimitives[SpikeyRegion3D, i], {i, 0, 2}];
transGroup =
Table[Table[
Map[(# + {0, 0, i}) &, regionData[[3]][[j]][[1]]], {i, 0, 50,
50}], {j, Length@regionData[[3]]}];
I use ConvexHull to generate prism-like polyhedrons from each triangle.
Grid@Partition[
Take[convexhullMesh = ConvexHullMesh[Flatten[#, 1]] & /@ transGroup,
16], 8]
![enter image description here][22]
Now, I use RegionUnion to join all generated prism-like polyhedrons together, It becomes a pulled long Spikey, but without changing the front and back side geometry.
regionUnion1 =
Table[BoundaryDiscretizeRegion[
RegionUnion @@ Take[convexhullMesh, {3 (i - 1) + 1, 3 (i)}]], {i,
1, 20}];
regionUnion2 =
Table[RegionUnion @@ Take[regionUnion1, {5 (i - 1) + 1, 5 i}], {i,
4}];
convexhullUnion =
RegionUnion[RegionUnion[regionUnion2[[1]], regionUnion2[[4]]],
RegionUnion[regionUnion2[[2]], regionUnion2[[3]]]]
![enter image description here][23]
Below I use RegionProduct to prepare a coin body with an outside protective ring.
regularPolygonMesh[r_Integer, n_Integer] :=
BoundaryMeshRegion[
Table[r {Cos[k 2 \[Pi]/n], Sin[k 2 \[Pi]/n]}, {k, n}],
Line[Append[Range[n], 1]]];
r1 = 21;
r2 = 23;
h1 = 25 + 41.5;
h2 = 25 - 41.5;
annulus =
RegionDifference[regularPolygonMesh[r2, 2*64],
regularPolygonMesh[r1, 2*64]];
line = Line[{{h2}, {h1}}];
tube = BoundaryDiscretizeRegion[RegionProduct[annulus, line]];
d1 = 25 - 7.5;
d2 = 25 + 7.5;
bottomPlate =
BoundaryDiscretizeRegion[
RegionProduct[regularPolygonMesh[r2, 2*64], Line[{{d1}, {d2}}]]];
assembly = RegionUnion[bottomPlate, tube]
![enter image description here][24]
Then I compress the 3D pulled Spikey into a relief model and export STL file for 3D printing. This transformation process takes about 10 seconds to complete.
![enter image description here][25]
Printout3D[SpikeyRelief, "SpikeyRelief" <> ".stl",
RegionSize -> Quantity[40, "Millimeters"]]
![enter image description here][26]
Similarly, we compress the 3D pulled coin into a coin model and export STL file for 3D printing. Later I will join the relief model and the coin model together. Usually, the coin ring is a little bit thicker than the relief height, so that the outside ring can protect the relief patterns and resist abrasion.
Coin = TransformedRegion[assembly,
ScalingTransform[0.03, {0, 0, 1}, {0, 0, 0}]]
![enter image description here][27]
Printout3D[Coin, "Coin" <> ".stl",
RegionSize -> Quantity[46, "Millimeters"]]
![enter image description here][28]
3. Visualizing
--------------
Let's take a glance at the whole model. The concept of coin design is **"Breakthrough"** or **"Penetration"**. It looks like, the spikey breaks or travels through a coin plate in space and time.
convexhullData =
MeshPrimitives[ConvexHullMesh[Flatten[#, 1]], 2] & /@ transGroup;
Graphics3D[{convexhullData, Opacity[.5], Red,
Cylinder[{{0, 0, 25 - 8}, {0, 0, 25 + 8}}, r1],
Blue, Opacity[.2], EdgeForm[None], MeshPrimitives[tube, 2]},
Axes -> True, ImageSize -> {600, 400}]
![enter image description here][31]
Set scale ratio is 0.025, and compress the 3D model into the relief model.
scale = 0.025;
subject =
GeometricTransformation[{convexhullData},
ScalingTransform[scale, {0, 0, 1}, {0, 0, 0}]];
body = GeometricTransformation[{Cylinder[{{0, 0, 25 - 7.5}, {0, 0,
25 + 7.5}}, r1]},
ScalingTransform[scale, {0, 0, 1}, {0, 0, 0}]];
ring = GeometricTransformation[{MeshPrimitives[tube, 2]},
ScalingTransform[scale, {0, 0, 1}, {0, 0, 0}]];
coin3D = Graphics3D[{ EdgeForm[None], ColorData["Atoms"]["Au"],
subject, White, body, ring }, Lighting -> Red, Boxed -> False,
ImageSize -> 400 {1, 1}]
![enter image description here][32]
vp = {{0, -Infinity, 0}, {-Infinity, 0, 0}, {0, 0, Infinity}, {0,
0, -Infinity}, {-1, -.1, 2}, {-1, -.1, -2}};
Grid[Partition[Table[
Graphics3D[{EdgeForm[None], Specularity[Brown, 100],
ColorData["Atoms"]["Cu"], subject,
LightBlue, Specularity[Red, 100], body,
Opacity[If[i == 1 || i == 2, .01, 0.9]], ring},
Axes -> If[i <= 4, True, False], Boxed -> If[i <= 4, True, False],
PlotRange -> Automatic,
AxesLabel -> (Style[#, 12, Bold] & /@ {"x", "y", "z"}),
ImageSize ->
Which[i == 1, {300, 100}, i == 2, {300, 100},
i == 3, {300, Automatic}, i == 4, {300, Automatic},
i == 5, {300, Automatic}, i == 6, {300, Automatic}],
ViewPoint -> vp[[i]]], {i, 1, Length@vp}], 2], Spacings -> 5]
![enter image description here][33]
As the concept of "Breakthrough" or "Penetration", the spikey should go through a coin plate. The two sides of the coin pattern (obverse and reverse) look similar, but they are not exactly the same. They are the front view {0, 0, Infinite} and the back view {0, 0, -Infinite} of the same Spikey.
Column[Row[{Column[{Style["Spikey Coin, Obverse, " <> #[[2]], 20],
Graphics3D[{EdgeForm[None], Specularity[#[[1]], 50],
ColorData["Atoms"][#[[2]]], subject, White, body, ring},
Boxed -> False, ViewPoint -> {-1.5, -2, 10},
ViewAngle -> Pi/30, Background -> Black,
ImageSize -> 300 {1, 1}]}, Alignment -> Center],
Column[{Style["Spikey Coin, Reverse, " <> #[[2]], 20],
Graphics3D[{EdgeForm[None], Specularity[#[[1]], 50],
ColorData["Atoms"][#[[2]]], subject, White, body, ring},
Boxed -> False, ViewPoint -> {-1.5, -2, -10},
ViewAngle -> Pi/30, Background -> Black,
ImageSize -> 300 {1, 1}]}, Alignment -> Center]
}] & /@ {{Brown, "Cu"}, {White, "Ag"}, {Yellow, "Au"}}]
![enter image description here][34]
4. 3D Printing and Prototypes
-----------------------------
**4.0 3D Model Quality**
My very first printed sample was bad. It was a Graphics3D-based model, so it has all faces glued together.
![enter image description here][41]
Then, I struggled to improve the model quality, move them into region-generated, discretization and defects should be checked and passed.
![enter image description here][42]
**4.1 FDM (Fused Deposition Modeling)**
FDM (Fused Deposition Modeling) is most widely used 3D printing technology works with thermoplastics at low cost, but it also has a relatively low accuracy.
![enter image description here][43]
![enter image description here][44]
I set the model in horizontal placement for high relief coin. It looks OK. But for low relief and thin parts, I later changed the placement to vertical or tilted attitude.
![enter image description here][45]
![enter image description here][46]
![enter image description here][47]
**4.2 SLA (Stereo-lithography)**
SLA (Stereo-lithography) is also 3D printing technology by using ultraviolet light to cure photosensitive polymers. Its advantage is that it has a higher accuracy in comparison to FDM.
![enter image description here][48]
![enter image description here][49]
If many Spikey 3D models and Spikey coins are printed together, they look like a square of Spartan warriors holding sharp spears and shields.
![enter image description here][410]
**4.3 MP (Metal Powder)**
Metal powder is a 3D printing process with a high accuracy and high cost, it is like a powder bed fusion and directed energy deposition grew at an explosive pace.
![enter image description here][411]
![enter image description here][412]
I also printed in metal powder processing with German equipment of [EOS M 290][413]. It's a 1 million dollars equipment with advanced additive manufacturing technology. The printed coins are made in material of stainless steel power. It has 40 mm outside diameter and 3 mm thickness, with thinnest region at coin plate only 0.5mm. It weights 15 grams. As you can see from the metal spikey coin, the relief pattern is clearly distinguishable. All faces of triangle form an optical diffuse reflection.
![enter image description here][414]
![enter image description here][415]
![enter image description here][416]
**4.4 Tips for 3D Printing**
- 3D printing model should be in good quality. Export STL from
Graphics3D is not good enough for 3D printing. Region is much better
and restrict define. You can kick Printing3D report and check your
model quality. Discretization and defects should all be checked and
passed.
![enter image description here][417]
- For a thin model, horizontal placement (background plane is put flat
on the printing table) results a poor resolution in sculpture.
Vertical or tilted placement wold helps to increase printable layers
and improve detail resolution in the relief.
5. Greetings
------------
This project was supported a lot friends. Thank you to all my friends in Wolfram China Community.
Finally, Yang and my family would like to share some images below for this moment as holiday greetings to all world-wide friends in Wolfram Community.
![enter image description here][51]
![enter image description here][52]
![enter image description here][53]
![enter image description here][54]
![enter image description here][55]
[51]: https://community.wolfram.com//c/portal/getImageAttachment?filename=G1.jpg&userId=569571
[52]: https://community.wolfram.com//c/portal/getImageAttachment?filename=G2.jpg&userId=569571
[53]: https://community.wolfram.com//c/portal/getImageAttachment?filename=G3.jpg&userId=569571
[54]: https://community.wolfram.com//c/portal/getImageAttachment?filename=G4.jpg&userId=569571
[55]: https://community.wolfram.com//c/portal/getImageAttachment?filename=G5.jpg&userId=569571
[41]: https://community.wolfram.com//c/portal/getImageAttachment?filename=408.png&userId=569571
[42]: https://community.wolfram.com//c/portal/getImageAttachment?filename=409.png&userId=569571
[43]: https://community.wolfram.com//c/portal/getImageAttachment?filename=410.gif&userId=569571
[44]: https://community.wolfram.com//c/portal/getImageAttachment?filename=412.png&userId=569571
[45]: https://community.wolfram.com//c/portal/getImageAttachment?filename=411.png&userId=569571
[46]: https://community.wolfram.com//c/portal/getImageAttachment?filename=423Processing_H1.gif&userId=569571
[47]: https://community.wolfram.com//c/portal/getImageAttachment?filename=422Processing_V1.gif&userId=569571
[48]: https://community.wolfram.com//c/portal/getImageAttachment?filename=421GIF_SLA.gif&userId=569571
[49]: https://community.wolfram.com//c/portal/getImageAttachment?filename=423SLA_SpikeyCoin.gif&userId=569571
[410]: https://community.wolfram.com//c/portal/getImageAttachment?filename=423.png&userId=569571
[411]: https://community.wolfram.com//c/portal/getImageAttachment?filename=431GIF_MetalPower.gif&userId=569571
[412]: https://community.wolfram.com//c/portal/getImageAttachment?filename=431.png&userId=569571
[413]: https://www.eos.info/eos-m290
[414]: https://community.wolfram.com//c/portal/getImageAttachment?filename=432.png&userId=569571
[415]: https://community.wolfram.com//c/portal/getImageAttachment?filename=433.png&userId=569571
[416]: https://community.wolfram.com//c/portal/getImageAttachment?filename=434SS_SpikeyCoin.gif&userId=569571
[417]: https://community.wolfram.com//c/portal/getImageAttachment?filename=441.png&userId=569571
[31]: https://community.wolfram.com//c/portal/getImageAttachment?filename=31.png&userId=569571
[32]: https://community.wolfram.com//c/portal/getImageAttachment?filename=32GIF.gif&userId=569571
[33]: https://community.wolfram.com//c/portal/getImageAttachment?filename=33.png&userId=569571
[34]: https://community.wolfram.com//c/portal/getImageAttachment?filename=34.png&userId=569571
[21]: https://community.wolfram.com//c/portal/getImageAttachment?filename=21.png&userId=569571
[22]: https://community.wolfram.com//c/portal/getImageAttachment?filename=22.png&userId=569571
[23]: https://community.wolfram.com//c/portal/getImageAttachment?filename=23.png&userId=569571
[24]: https://community.wolfram.com//c/portal/getImageAttachment?filename=24.png&userId=569571
[25]: https://community.wolfram.com//c/portal/getImageAttachment?filename=25.png&userId=569571
[26]: https://community.wolfram.com//c/portal/getImageAttachment?filename=26.png&userId=569571
[27]: https://community.wolfram.com//c/portal/getImageAttachment?filename=27.png&userId=569571
[28]: https://community.wolfram.com//c/portal/getImageAttachment?filename=28.png&userId=569571
[11]: https://en.wikipedia.org/wiki/Relief
[12]: https://community.wolfram.com//c/portal/getImageAttachment?filename=10.png&userId=569571
[13]: http://demonstrations.wolfram.com/DesignYourOwnCommemorativeCoin/
[14]: https://community.wolfram.com//c/portal/getImageAttachment?filename=11.png&userId=569571
[15]: https://community.wolfram.com//c/portal/getImageAttachment?filename=12.png&userId=569571
[16]: https://community.wolfram.com//c/portal/getImageAttachment?filename=13.png&userId=569571
[17]: https://community.wolfram.com//c/portal/getImageAttachment?filename=14.png&userId=569571
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=01.png&userId=569571
[2]: https://reference.wolfram.com/language/ref/BlockchainData.html
[3]: http://blog.wolfram.com/2018/06/21/weve-come-a-long-way-in-30-years-but-you-havent-seen-anything-yet/
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=02.png&userId=569571
[5]: http://mathworld.wolfram.com/Spikey.html
[6]: https://www.wolfram.com/
[at0]: https://community.wolfram.com/web/wufei1978
[at1]: https://community.wolfram.com/web/shenghuiyFrederick Wu2018-12-12T10:46:24ZDefinite Integrals of large symbolic equations?
https://community.wolfram.com/groups/-/m/t/1571412
I have a set of large polynomial symbolic equations that I need to solve definite integrals for. Wolfram is not understanding most of my entries (they have been double checked and syntax is correct) but occasionally I can get one solved by Wolfram. I have purchased Pro to see if this helps an I haven't noticed a difference. Will Pro Premium help solve these?
Or are their any other suggestions for solving these? I have tried Maxima and can not get it to work. I am currently downloading a Mathmatica trial. I do not have access to Matlab or any other software I know of.
Thanks!Jacob Switzer2018-12-15T16:41:42ZSAS Help with PROC GLIMMIX
https://community.wolfram.com/groups/-/m/t/1571098
Hello everyone,
I’m seeking your help
I’m working on dataset from the 1988 Bangladesh Fertility Survey. It consists of 1934 women who are grouped in 60 districts; the response of interest is whether these women were using contraceptives at the time of the survey. Explanatory variables include age(centered), the number of existing children (0,1,2,3+) and whether the district is urban (1) or rural(0).
I have three objectives :
1- calculate the marginal effect of the number of children of the woman on her decision
to use contraceptive methods at the time of the survey.
2- check if this effect is modified by the environment in which the woman lives (urban or
rural).
3- And evaluate the impact of district women's grouping on the results (versus
Ignoring the districts in the analysis).
Here are my variables
• ID: numerical identifier of each woman
• Area: district identifier
• Contraceptive: Variable response of contraceptive use (1 = yes, 0 = no)
• Children: number of children of the woman (note: the value 3 actually represents "3
or more ")
• Age_centered: the age of the woman in years minus 29.56 years (the average age
sample)
• Urban: urban indicator variable (1 = urban, 0 = rural)
For Question 1, I suggest:
/* questio 1*/
PROC GLIMMIX DATA = benga infocrit=pq;
NLOPTIONS MAXITER = 100;
CLASS children urban;
MODEL contraceptive = children age_centered urban area children*urban
/ DIST=bin s link=logit chisq oddsratio ddfm=kr;
RANDOM intercept/ SUBJECT = area solution residual;
OUTPUT OUT = sortie STUDENT = resid PRED = predit;
RUN;
/*question 2*/
PROC GLIMMIX DATA = benga infocrit=pq;
NLOPTIONS MAXITER = 100;
CLASS children urban;
MODEL contraceptive = children age_centered urban area children*urban
/ DIST=bin s link=logit chisq oddsratio ddfm=kr;
RANDOM intercept/ SUBJECT = area solution residual;
ESTIMATE "Urban vs Rural" children 1 urban 1 / EXP;
OUTPUT OUT = sortie STUDENT = resid PRED = predit;
RUN;
/*question 3*/
PROC GLIMMIX DATA = benga infocrit=pq;
NLOPTIONS MAXITER = 100;
CLASS children urban;
MODEL contraceptive = children age_centered urban area children*urban
/ DIST=bin s link=logit chisq oddsratio ddfm=kr;
RANDOM intercept/ SUBJECT = id;
OUTPUT OUT = sortie STUDENT = resid PRED = predit;
RUN;Phill M2018-12-15T17:08:05ZGraphics from headless raspberry pi
https://community.wolfram.com/groups/-/m/t/1571389
I log into my new raspberry pi 3B+ remotely via ssh
from my iMac. I have XQuartz running on the iMac.
I'm only interested in running "wolfram" from a terminal remotely.
I'm not interested in Mathematica NoteBooks for now.
I'd like to run graphics.
When I try to load <<JavaGraphics`
I get the following error.
In[7]:= <<JavaGraphics`
libGL error: No matching fbConfigs or visuals found
libGL error: failed to load driver: swraststewart mandell2018-12-15T16:24:05ZMathematica in Battlefield: Sniper Detection.
https://community.wolfram.com/groups/-/m/t/1571168
Hi everyone ,
I'd like to share my work about SNIPER DETECTIONwhich I prepared in 2015 for Wolfram Technology Conference. Unfortunately I didin't have the chance to participate so I want to share it with the community here.
Modern armed military engagements pose several severe threats to the operating men and women in uniforms especially in novel genres of warfare such as urban operations, insurgency and guerilla warfare. Sniper fire is a prevalent cause of loss in contemporary armed engagements, which is very hard to foresee and prevent due to its nature. Several systems developed to solve this problem are designed to locate the sniper after the shot such as acoustic, Infra Red and radar detection solutions Other active emission solutions comprise radars systems localizing barrels or exploits cat-eye effect principle using back scattering of emitted light by the sight or binocular of the sniper. The former types of solutions fail to produce a warning until the sniper pulls the trigger. The latter ones rely on active emission of radar or light waves which might become a disadvantage for the detection of the detector. A passive but preemptive system might be a progressive approach in this field, in the shape of a properly implemented solution based on image analysis. This study attempts to create a preliminary theoretical start with Mathematica Software, to passive, preshooting sniper detection problem.OZGUN CAN2018-12-15T09:51:09ZFit data with a proper Gaussian using NonlinearModelFit?
https://community.wolfram.com/groups/-/m/t/1568328
Hi everybody. I need help!
I'm trying to fit my data set with a Gaussian, but I was able to get a curve that doesn't look like a Gaussian. I'm noob with this, so you guys please help me!
At least I wanna have a hint about how can I handle the parameters to get the best as possible fit. This is what I already have done...
data = Import[
"/home/leblanc/Documents/Astro/Paper/a.csv", "table", FieldSeparators -> " "];
nlm = NonlinearModelFit[data, a Exp[-(x - b)^2/2 c^2], {a, b, c}, x];
nlm["AdjustedRSquared"];
nlm[x];
nlm["ParameterTable"];
dataplot = ListPlot[data];
fitplot = Plot[nlm[x], {x, 1.8, 2.00}];
Show[dataplot, fitplot];Christian Leblanc2018-12-09T05:19:09ZNot able to read Arduino Serial Monitor
https://community.wolfram.com/groups/-/m/t/1571051
I am reading a sensor that returns data CSV with multiple real numbers but my code not reading the numbers. I will like to create a graph
dev = DeviceOpen["Serial", {"COM8", "BaudRate" -> 9600}]
(*This is for windows platform port format.Replace COMx with x been \
the port number and budrate same as in sketch*)
data = {};
volt = {};
task = RunScheduledTask[
If[dataDeviceExecute[dev, "SerialReadyQ"],
Module[{csv, raw}, csv = FromCharacterCode[DeviceReadBuffer[dev]];
raw = Flatten[Cases[ImportString[csv, "CSV"], {_Real}]];
volt = ToExpression[raw, TraditionalForm];
data = Join[data, volt];]], 2]
(*Print[Dynamic[volt]]
Dynamic[ListLinePlot[data]]*)
Sample of data pritned in serial monitor
22,514.00,316.00,1211.00,1013.00,1423.00,358.00
22,514.00,316.00,1210.00,1013.00,1423.00,358.00
22,514.00,298.00,1210.00,1012.00,1423.00,358.00
22,514.00,316.00,1210.00,1013.00,1421.00,358.00
23,514.00,316.00,1210.00,1013.00,1423.00,358.00
![enter image description here][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot_1.png&userId=120134Jose Calderon2018-12-15T05:07:39ZWTC 2017: Will the Compiler talk be online?
https://community.wolfram.com/groups/-/m/t/1227581
Hey Wolfram Team,
the presentations of the [WTC 2017 are online](https://www.wolfram.com/events/technology-conference/2017/presentations/#wednesday). Unfortunately, the one I was most excited about is not available
![img](https://i.imgur.com/LRFuxHy.png)
Is this going to be available as well?Patrick Scheibe2017-11-24T00:55:59ZA Prime Pencil
https://community.wolfram.com/groups/-/m/t/1569707
![a very prime pencil][1]
I just got a set of these pencils, from [Mathsgear][2].
The number printed on it is prime, and will remain so as you sharpen the pencil from the left, all the way down to the last digit, 7.
Here is a recursive construction of all such *truncatable primes*.
TruncatablePrimes[p_Integer?PrimeQ] :=
With[{digits = IntegerDigits[p]},
{p, TruncatablePrimes /@ (FromDigits /@ (Prepend[digits, #] & /@ Range[9]))}
];
TruncatablePrimes[p_Integer] := {}
The one on the pencil is the largest one,
In[7]:= Take[Sort[Flatten[TruncatablePrimes /@ Range[9]]], -5]
Out[7]= {
9918918997653319693967,
57686312646216567629137,
95918918997653319693967,
96686312646216567629137,
357686312646216567629137}
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=IMG_20181212_120939.jpg&userId=143131
[2]: https://mathsgear.co.uk/products/truncatable-prime-pencilRoman Maeder2018-12-12T12:01:36Z[MAKE] Boot Logo for a Laptop
https://community.wolfram.com/groups/-/m/t/1570390
**[Open in Cloud][1] | Attachments for Desktop at the End**
*_WARNING: Customizing boot logo of the laptop might require flash the BIOS firmware, which has a small chance to fail and permanently "brick" the laptop!_*
![enter image description here][2]
Just as many people, I do a lot of work on my laptop. And naturally, just like many people, I want to customize it to feel like "mine". One thing I always wanted was to change the boot logo, since that's the first thing you see when you wake up your electric friend. Image my excitement when I found out that there's an official BIOS Update Utility just for that for my ThinkPad T440s! The only catch, according to the vaguely written documentation in the utility, and a bunch of internet articles I found, it seems that the logo designs are subject to certain constraints:
1. the most suitable format is **GIF**
2. image dimensions must be **less than 768 x 432**
3. image must be below **30KiB**.
Having got that out of the way, it's time to make my awesome logo!
As a start, I generated a vector drawing using the _Constantia_ font and the lovely `\[LightBulb]` icon.
vectorgraph = ExportString[
Style["i\[LightBulb]ea", 100, Bold, FontFamily -> "Constantia"] // Echo
, "PDF"] //
ImportString[#, "PDF"][[1]] &
![vectorgraph][3]
I wanted my logo to look low-poly styled. Firstly, I made the edges jagged by chossing a large value for `MaxCellMeasure`.
bregionInit = vectorgraph // BoundaryDiscretizeGraphics[ #, MaxCellMeasure -> 10 ] &
![bregionInit][4]
Next, I trianglized the region with `TriangulateMesh`. For the same reason, a large `MaxCellMeasure` really helps to give the low-poly effect. In addition, a high `MeshQualityGoal` is necessary to create somewhat regular triangle pieces.
At this point, the **30KiB** limitation I talked about earlier comes into play. Many triangles means more details means larger file size, even for GIF. Through some good old eye-balling, I settled on a value of 0.7, which manages to look great while still staying under the limit.
mesh = TriangulateMesh[ bregionInit
, MeshQualityGoal -> .7
, MaxCellMeasure -> 200 ]
![mesh][5]
The shape looks good to me. For afterward manipulation, let's collect all the triangles with their positions.
polys = MeshPrimitives[mesh, 2];
centers = PropertyValue[{mesh, 2}, MeshCellCentroid];
polys // Short
centers // Short
(*
{Polygon[{{2.115,19.2363},{4.8094,19.2363},{1.94625,20.9013}}],<<367>>,Polygon[<<1>>]}
{{2.95688,19.7913},<<367>>,{58.7516,38.3716}}
*)
Pretty good, but better with some colors!
One possible way to paint my triangles is to shade them according to their heights.
To do that I extracted the heights and rescaled them to get a percentage $\lambda$ so those near the central horizontal line have values near 0, and those furthest have values near 1. It will serve as a "gradient mask" for later use.
λs = centers[[;; , 2]] // RightComposition[
Through@*{Identity, Mean}
, Apply[Subtract]
, Abs /* Rescale
];
Time to choose a color scheme. I find `"StarryNightColors"` very delightful.
polysNew = MapThread[Function[{p, c, λ},
{
FaceForm[ColorData["StarryNightColors"][2 λ]]
, p}
]
, {polys, centers, λs}
, 1];
polysNew // Shallow /* Short
(*
{{FaceForm[<<1>>],Polygon[<<1>>]},{FaceForm[<<1>>],Polygon[<<1>>]},<<7>>,{FaceForm[<<1>>],Polygon[<<1>>]},<<359>>}
*)
logo = Graphics[{polysNew}, Background -> Black, PlotRangePadding -> 0]
![logo_1][6]
Looks much better now, isn't it?
However, I am still not satisfied. Bearing in mind the file size restriction, maybe I can experiment with some geometric transformations?
logo = Block[{
polysNew,
λTransFunc = Function[x, (1 - Cos[π/2 x]^3)/2]
},
polysNew = MapThread[Function[{p, c, λ},
{
FaceForm[ColorData["StarryNightColors"][2 λ]]
, MapAt[(1 - λ) # + λ c &, {1, ;;}]@p}
]
, {polys, centers, λs // λTransFunc}
, 1];
Graphics[{polysNew}, Background -> Black, PlotRangePadding -> 0]
]
![logo_2][7]
Not bad, except that the central pieces are now waaay too dark. Let's add some bright edges for them.
logo = Block[{
polysNew,
λTransFunc = Function[x, (1 - Cos[π/2 x]^3)/2]
},
polysNew = MapThread[Function[{p, c, λ},
{
If[λ > .3, {},
EdgeForm@{GrayLevel[1 - λ^.5], AbsoluteThickness[0]}
]
, FaceForm[ColorData["StarryNightColors"][2 λ]]
, MapAt[(1 - λ) # + λ c &, {1, ;;}]@p}
]
, {polys, centers, λs // λTransFunc}
, 1];
Graphics[{polysNew}, Background -> Black, PlotRangePadding -> 0]
]
![logo_3][8]
The warming yellow has been restricted to the light bulb, leaving me pure deep blue glossy letters. I think I'm good to go :D
To fit the constraint of the utility tool, the final work is to rasterize the image and export it to GIF.
logoImg = logo //
RightComposition[
Image[#, ImageSize -> 1000] &
, ImagePad[#, 50, Black] &
, ImageResize[#, 768 + 45] &
, ImageCrop
];
logoFile = Export[
FileNameJoin[{NotebookDirectory[], "logoImg.gif"}]
, logoImg
, "GIF"
];
Unfortunately, despite my very carefully tuning, the resulting GIF still exceeded the file size limitation of 30KiB.
FileSize[logoFile] // UnitConvert[#, "Kibibytes"] &
48.8789KiB
I searched around and came to a commandline tool called [Gifsicle](https://github.com/kohler/gifsicle). The following command (run in OS' console) finally did the trick. Hurray!
gifsicle -k 50 -O3 --no-extensions --no-comments < logoImg.gif > LOGO2.gif
Now check the perfect file size,
FileSize[FileNameJoin[{NotebookDirectory[], "LOGO2.gif"}]] //
UnitConvert[#, "Kibibytes"] &
29.7598KiB
The rest is refreshingly straight forward. I dropped my LOGO2.GIF in the utility's own directory and executed the firmware update utility. It automatically picked up the logo image and proceeded to modify my firmware. One reboot later, I was rewarded by my very own boot logo!
![t440s boot image][9]
_Easter eggs:_
Can you guess what happened when I remembered my another old ThinkPad the next day?
![other boot image][10]
(The color scheme used here was `"CoffeeTones"`.)
At last, the family photo of my electric friends :)
![family photo][11]
----
Thanks for watching and ... ...
*Stay tuned!* Next post we will share our experiment on making cool booting animation with *Mathematica* for Android phones! :)
[1]: https://www.wolframcloud.com/objects/wolfram-community/MAKE-Boot-Logo-for-a-Laptop-by-Silvia-Hao
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-12-14at4.35.36AM.jpg&userId=11733
[3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=logo_font.png&userId=93201
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=logo_bdRegion.png&userId=93201
[5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=logo_tRegion.png&userId=93201
[6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=logo_1.png&userId=93201
[7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=logo_2.png&userId=93201
[8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=logo_3.png&userId=93201
[9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=logo_t440s.png&userId=93201
[10]: https://community.wolfram.com//c/portal/getImageAttachment?filename=logo_other.png&userId=93201
[11]: https://community.wolfram.com//c/portal/getImageAttachment?filename=logo_family.png&userId=93201Silvia Hao2018-12-13T17:51:14Z[GIF] Bounce ((3,1)+(1,3) vibration mode of a square membrane)
https://community.wolfram.com/groups/-/m/t/1567736
![(3,1)+(1,3) vibration mode of square membrane][1]
**Bounce**
The vibration modes of a rectangular membrane of width $L_x$ and length $L_y$ are
$\Psi_{mn}(x,y) = \sin\left(\frac{\pi m}{L_x}x\right) \sin\left(\frac{\pi n}{L_y}y\right);$
in other words, each direction just consists of standing waves with wavelength given by the reciprocal of some integer multiple of the length of the side of the membrane.
Ψ[m_, n_, {x_, y_}] := Sin[m π x] Sin[n π y];
In general these modes all have different frequencies, but when, e.g., one side length is a multiple of the other, it is possible for two different modes to have the same frequency, and then linear combinations of modes of the same frequency will also be vibration modes of the membrane. See [Dan Russell's demo][2] for more.
This animation shows the combination of the $(1,3)$ mode and the $(3,1)$ mode of the square where each factor is equally weighted. (Compare previous vibration mode animations [_Square Up_][3], [_Drumbeat_][4], and [_Things That Go Bump in the Night_][5]).
Here's the code:
DynamicModule[{n = 25, a = 1.2, dots,
cols = RGBColor /@ {"#0098d8", "#f54123", "#0b3536"}},
Manipulate[
dots = Table[
{2 π (x - 1)/n, 2 π (y - 1)/n,
Cos[θ] (1/Sqrt[2] Ψ[3, 1, {(x - 1)/n, (y - 1)/n}] + 1/Sqrt[2] Ψ[1, 3, {(x - 1)/n, (y - 1)/n}])},
{x, 1, n + 1}, {y, 1, n + 1}];
Graphics3D[
{AbsoluteThickness[2],
Table[
Line[#[[i]], VertexColors -> (Blend[cols[[;; -2]], (# + a)/(2 a)] & /@ #[[i, ;; , 3]])],
{i, Length[#]}] & /@ {dots, Transpose[dots]}},
Boxed -> False, PlotRange -> {{0, 2 π}, {0, 2 π}, {-2, 2}},
ImageSize -> 540, ViewPoint -> {2, 0, 1/2},
SphericalRegion -> True, Background -> cols[[-1]]],
{θ, 0, 2 π}]
]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=rolling34Lr.gif&userId=610054
[2]: https://www.acs.psu.edu/drussell/Demos/rect-membrane/rect-mem.html
[3]: https://community.wolfram.com/groups/-/m/t/896369
[4]: https://community.wolfram.com/groups/-/m/t/899038
[5]: https://community.wolfram.com/groups/-/m/t/985795Clayton Shonkwiler2018-12-07T21:38:05ZPrint a single list using the following function?
https://community.wolfram.com/groups/-/m/t/1569634
I want to print a list from a function but It gives me 4 lists. I think I shouldn't use Print[] function.
Here is the code:
alista = {{2, 1}, {4, 4}, {7, 5}, {10, 5}, {12, 5}};
alist3a = {};
fnk[n_] :=
Which[n == 1, Do[
alist2a = {(alista[[k, 1]] +
alista[[k + 1, 1]])/(2), (alista[[k, 2]] +
alista[[k + 1, 2]])/(2)}
;
AppendTo[alist3a, alist2a] && Print[Sort[Join[alista, alist3a]]]
, {k, 1, Length[alista] - 1}],
n == 2, Do[
alist2a = {alista[[i,
1]] + (-alista[[i, 1]] + alista[[i + 1, 1]])/(3),
alista[[i, 2]] + (-alista[[i, 2]] + alista[[i + 1, 2]])/(3)}
;
AppendTo[alist3a, alist2a] && Print[Sort[Join[alista, alist3a]]]
, {i, 1, Length[alista] - 1}];
Do[
alist3aa = {alista[[i,
1]] + (-alista[[i, 1]] +
alista[[i + 1, 1]])/(3) + (-alista[[i, 1]] +
alista[[i + 1, 1]])/(3),
alista[[i,
2]] + (-alista[[i, 2]] +
alista[[i + 1, 2]])/(3) + (-alista[[i, 2]] +
alista[[i + 1, 2]])/(3)};
AppendTo[alist3a, alist3aa] && Print[Sort[Join[alista, alist3a]]]
, {i, 1, Length[alista] - 1}]]
fnk[1]
The output is
{{2,1},{3,5/2},{4,4},{7,5},{10,5},{12,5}}
{{2,1},{3,5/2},{4,4},{11/2,9/2},{7,5},{10,5},{12,5}}
{{2,1},{3,5/2},{4,4},{11/2,9/2},{7,5},{17/2,5},{10,5},{12,5}}
{{2,1},{3,5/2},{4,4},{11/2,9/2},{7,5},{17/2,5},{10,5},{11,5},{12,5}}
The requested output is the last row in the printed list.
{{2,1},{3,5/2},{4,4},{11/2,9/2},{7,5},{17/2,5},{10,5},{11,5},{12,5}}Nagon Stewart2018-12-11T20:16:24ZI can not "open code" anymore
https://community.wolfram.com/groups/-/m/t/1570183
I have mathematica installed on my PC and I am logged in on wolframalpha.com. When i type in any eqauation on the website and then push the button "open code" a new page is loading but it stays empty.
Is there sth. wrong with my security setting?
Thx for any help. If my question is unclear just me.andreas gernert2018-12-13T11:00:39ZHas Wolfram abandoned the Graphs and Networks functionality?
https://community.wolfram.com/groups/-/m/t/1321057
This is a cautionary tale for those who choose Mathematica as the main tool for their work.
It is now clear to me that Wolfram has simply abandoned the [Graphs and Networks](http://reference.wolfram.com/language/guide/GraphsAndNetworks.html) functionality area and I am left high and dry. I have no recourse because Mathematica is closed source so there is only so much a user can do to fix or work around problems. Reporting bugs in this particular area has now clearly proven to be useless. Most simply do not get fixed, no matter how serious they are, or how great a hindrance they are to practical use. No new functionality has been added since version 10.0. My colleagues who use other tools (mostly Python and R packages) are more productive at this point, but I have a handicap with those systems because I made the mistake of investing most of my time into Mathematica, and stayed optimistic about it even in the face of the most obvious warning signs.
I am writing this post because those people who have not heavily invested in Mathematica, and in particular this functionality area of Mathematica, are not in a position to see this and may fall in the same trap I did. What if the same thing happens to the functionality area that is critical to *your* work?
Wolfram Research, of course, will not tell you that they gave up on `Graph`. Thus, after my experience, I think I owe it to the community to warn you about the situation.
----
Some might ask me what specifically is wrong. I have made many posts on this forum about `Graph`-bugs (you only have to search), and I reported many more to WRI. There is always a last straw—it would be pointless to show it. Those who know me will know that I am not writing this admittedly emotional post out of ill will towards WRI. I have betted on Mathematica more than most, and have been advocating for it throughout the years. I even have a network analysis package with ~250 functions. If I am forced to abandon Mathematica for this type of work, then the countless hours that went into this package will all have been in vain.
I admit that I am writing this public post partly out of desperation to try to get WRI to either fix the many serious `Graph`-problems, or otherwise publicly state that `Graph` is now abandoned so those of us who have been using it can stop wasting our time.Szabolcs Horvát2018-04-16T09:54:42ZMathematica Version 3.0 needed please - want to purchase.
https://community.wolfram.com/groups/-/m/t/1210066
Mathematica Version 3.0 needed please - want to purchase. Bill 760 253 5261Bill Depue2017-10-27T20:00:40ZDefine modified Mathieu functions?
https://community.wolfram.com/groups/-/m/t/1569288
Hello,
Could you please advise me how I can define the modified Mathieu function in Mathematica? Mathematical has MathieuC and MathieuS functions but does not have modified Mathieu functions Me, Fe, Ge.
Thank you kindly,Nafiseh Sang-Nourpour2018-12-12T18:35:30ZThe Humanities and Wolfram Language: a WTC 2018 follow-up
https://community.wolfram.com/groups/-/m/t/1534349
At the recently completed Wolfram Technology Conference, there was a meet up about the humanities and Wolfram Language. I attended because I have an interest in this topic. I gave a talk at the conference on Hermeneutics and Wolfram Language. (The text of the talk is provide in the attached notebook.) It was pointed out that most of the developers and managers at Wolfram Research do not have a background in the arts or humanities.
Among other things, this issue was discussed.
President Obama had used the phrase *"they gave the last full measure of devotion"* in several of his speeches.
There were two questions:
1: Should an AI system be able to recognize that this is a quote from Lincoln's Gettysburg Address?
2: (The more interesting question) Should an AI system know that this phrase referred to death?
For the first question, given the fact that the Gettysburg Address is in the public domain, it should be easy enough to write code in WL that would scan a document looking for quotes of this nature. It would be a useful project to expand the source material to Shakespeare and the King James translation of the Bible, since most of us, one way or another, are using words or phrases from these two documents every day.
For the second question, the basic idea is that an AI system should be able to understand metaphor. The general consensus was that an AI system should be able to understand *this* metaphor, and by extension, any metaphor.
If there is to ever be a "computational literature", this problem needs to be solved. Current functionality in Wolfram Language, and as far as I know, code using WL, is inadequate to this task. It does pretty will at the "Dick and Jane" level, or for basic cook-book texts, but not for anything as complex as Austen, let alone Beckett, Joyce, Shakespeare, or Dickens.
Note that most of you know exactly what I was talking about when I used the phrase "Dick and Jane", but a computer would be flummoxed.
The same thing is true for the fine arts and music.
I know that WL has been used successfully for making patterns for carpets and wallpaper, but these are crafts, not art. Fractal images are interesting, but they carry no emotional content.
Similarly, I am familiar with many types of algorithmically generated music, but the results are only "music" in a very broad sense. As a replacement for MUZAK or a background to a computer game, they may be interesting, but as art, they are far below the level of a Robert Shechtman (my first composition teacher), let alone Stravinsky, Mozart or Beethoven.
I am also aware that there is software that can analyze J. S. Bach's entire output and generate chorales that 'sound like' the real thing. This is not that great an accomplishment: any student who completes a course in music theory can do the same thing. Again, there is no emotional content, and an expert would not be fooled.
I could go on with more examples.
The point is this: Stephen Wolfram has stated many times that there is or soon will be a "computational X" for any field. I think that this is naive. At best, WL can handle some peripheral aspect of a humanity (music, art, history, etc.), but not its core questions.
For example, WL can provide maps, facts and figures for events in History. It cannot provide any insight into motivations, context, or consequences. For people who only are exposed to History in K-12, History seems to be about memorizing names and dates, but this is a failing of the educational system and not a realistic understanding of what it means to study history.
Stephen Wolfram has expressed the desire to extend the types of users of WRI's technology beyond scientists and engineers. Right now, Machine Learning and Algorithms seem to hold a lot of promise.
However, from what I have seen, read, and experienced, the existing level of technology **and its reasonable extensions** cannot begin to address the central concerns of the humanities, and to pretend otherwise will do nothing except to alienate those people we wish to include.
I am posting this because I would be interested in comments or suggestions.
geo3rgeGeorge Woodrow III2018-10-25T17:13:55ZNumerical issues when integrating a (fixed) delayed pulse in System Modeler
https://community.wolfram.com/groups/-/m/t/1569592
*I have posted a similar question on StackOverflow ([here][1]), as it seems -- with the alleged exception of SimulationX -- to appear in System Modeler as well as in OpenModelica and Dymola. I believe that the issue may be of interest for this community and I would be very interested to see whether the issue is only related to System Modeler 4.3 (which I used for testing the issue) and what best can be done to avoid the sometimes tremendous errors within a model.*
**The Problem (minimum example)**
I noted numerical errors trying to build a [System Dynamics][2] library where a component called "*conveyor*" typically is used to model the transport of an amount of some material from one *stock* to another using a *fixed delay* (also called *pipeline delay* in [SD lingo][3]). The issue seems closely related to event handling as becomes apparent especially when a pulse input is delayed, that uses time events in the Modelica standard library component:
![Model Diagram for Pulse Test][4]
model PulseTest "Test FixedDelay with Pulse Input"
Modelica.Blocks.Nonlinear.FixedDelay fixedDelay( delayTime = 5 );
Modelica.Blocks.Sources.Pulse pulse(
startTime = 1,
width = 100,
period = 1/32,
amplitude = 32,
nperiod = 1
);
Modelica.Blocks.Continuous.Integrator x; // integrator for the undelayed pulse
Modelica.Blocks.Continuous.Integrator y; // integrator for the delayed pulse
equation
connect( pulse.y, fixedDelay.u );
connect( fixedDelay.y, y.u );
connect( pulse.y, x.u );
end PulseTest;
We have a pulse signal with amplitude *a* and a period (width = 100%) of *1/a* which being integrated should eventually give 1.0 by the end of the simulation.
Simulating this simple model using DASSL from time 0 to 10 with standard settings (e.g. 2000 steps) will give these results:
![Plot over time][5]
As we can see, the undelayed pulse correctly accumulates to 1.0 (*x*), while the delayed signal overshoots (*y*).
There is no easy way to fix this (greatly increasing the solver steps is one remedy) it seems. Euler fixed step for example correctly simulates the model, while the pulse disappears using Runge Kutta or Heun's method.
**What is the best ("most robust and reliable") way to deal with this issue?**
**UPDATE (12/18/18):**
Comments and a first answer by a Dymola developer give a confusing picture (cf. [my post on SO][6]): It seems that SimulationX, another commercial simulation environment for Modelica, will give the correct solution irrespective of solution method, while the Dymola developer states, that there is no easy workaround making event-propagation possible when choosing a variable step solver.
[1]: https://stackoverflow.com/q/53709983
[2]: https://en.wikipedia.org/wiki/System_dynamics
[3]: https://sds.memberclicks.net/assets/SDGlossary.pdf
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ModelPulseTest.PNG&userId=566944
[5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=rd8Aw.png&userId=566944
[6]: https://stackoverflow.com/q/53709983/5363743Guido Wolf Reichert2018-12-12T09:52:24ZCombine GridLines and Ticks in a Plot?
https://community.wolfram.com/groups/-/m/t/1569353
MMA 11.3. I can add GridLines to a Plot (GridLines -> Automatic), but then when I try to add Ticks to the same plot using Ticks -> {Range[0, 2 pi, pi/2}], the Grid lines go away. Here are screeshots of 2 successive input cells.
![enter image description here][1]
![enter image description here][2]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=MMA-1.jpg&userId=1568104
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=MMA-2.jpg&userId=1568104Thomas Seibel2018-12-11T21:19:57ZThe "Mathy" Arts of Coding Postcards
https://community.wolfram.com/groups/-/m/t/1569557
**[Open in Cloud][1]** | **Attachments for Desktop at the End** | *LARGE images, wait till they load*
----------
![enter image description here][2]
----------
And so, the holidays are upon us once more and celebrations are in order. Wolfram Language fans enjoy fun recreation and arts, because beautiful things can be made with beautiful code, concise and elegant. I wanted to find a few gems from the past to honor the holidays and the traditions our users have. Surprisingly those few gems combined into one Christmas postcard you can see above.
The story of this postcard begins six years ago, when our sister community Mathematica Stack Exchange sprang up a question about simulating a snow fall with Wolfram Language. One of Wolfram most creative users, [@Simon Woods][at0] gave a [wonderful answer][3] that was very popular. Then about five years ago I have run into a [viral Reddit discussion][4] dubbed
$$t * sin (t) ≈ Christmas tree$$
which showcased a beautiful minimalistic Christmas tree built with simple $t * sin (t)$ function and Java Script. I recreated the concept with Wolfram Language and our another wonderful user [@Silvia Hao][at1] ornamented it with [festoon lamps][5]. An idea came to me to combine them, because a Christmas Tree sparkling lights in a snowfall is the icon of winter holidays. But beware a few subtle tricks ;-) In depth those discussed at the original references I gave. Below are slightly changed code and a few comments.
## The Tree
Our Christmas Tree is indeed spun with $t * sin (t)$. But in 3D rather than 2D. This is basically a conical spiral whose amplitude increases, a 2D circle dragged along 3-rd axis like [this][6]:
![enter image description here][7]
but only with increasing radius. Density of lights and their motion is one subtlety to take care of with math. Another subtlety is increasing 3D depth perception by slightly dimming the lights that are further from the observer. This function defines the mathematics of the tree:
PD = .5;
s[t_, f_] := t^.6 - f
dt[cl_, ps_, sg_, hf_, dp_, f_, flag_] :=
Module[{sv, basePt},
{PointSize[ps],
sv = s[t, f];
Hue[cl (1 + Sin[.02 t])/2, 1, .8 + sg .2 Sin[hf sv]],
basePt = {-sg s[t, f] Sin[sv], -sg s[t, f] Cos[sv], dp + sv};
Point[basePt],
If[flag,
{Hue[cl (1 + Sin[.1 t])/2, 1, .8 + sg .2 Sin[hf sv]], PointSize[RandomReal[.01]],
Point[basePt + 1/2 RotationTransform[20 sv, {-Cos[sv], Sin[sv], 0}][{Sin[sv], Cos[sv], 0}]]},
{}]
}]
and this code uses the function to build 228 frames of the animated tree:
treeFrames = ParallelTable[
Graphics3D[Table[{
dt[1, .01, -1, 1, 0, f, True],
dt[.45, .01, 1, 1, 0, f, True],
dt[1, .005, -1, 4, .2, f, False],
dt[.45, .005, 1, 4, .2, f, False]},
{t, 0, 200, PD}],
ViewPoint -> Left, BoxRatios -> {1, 1, 1.3},
ViewVertical -> {0, 0, -1}, Boxed -> False,
ViewCenter -> {{0.5, 0.5, 0.5}, {0.5, 0.55}},
PlotRange -> {{-20, 20}, {-20, 20}, {0, 20}},
Background -> Black,ImageSize->350],
{f, 0, 1, .0044}];
Let's check a single frame of THe Tree:
First[treeFrames]
![enter image description here][8]
## The Snow
This function below builds a single random snowflake. They are of course six-fold symmetric polygons.
flake := Module[{arm},
arm = Accumulate[{{0, 0.1}}~Join~RandomReal[{-1, 1}, {5, 2}]];
arm = arm.Transpose@RotationMatrix[{arm[[-1]], {0, 1}}];
arm = arm~Join~Rest@Reverse[arm.{{-1, 0}, {0, 1}}];
Polygon[Flatten[arm.RotationMatrix[# \[Pi]/3] & /@ Range[6], 1]]];
Let's see a few random shapes, they are fun in black on white ;-)
Multicolumn[Table[Graphics[flake, ImageSize -> 50], 100], 10]
![enter image description here][9]
Now it's time to build the `snowfield` which has a few tricks. To simulate 3D perception 2 things need to be obsereved:
1. Real further snowflakes appear smaller
2. Real further snowflakes have slower perceived angular speeds
The 2nd observation is taken care of by the `size_` variable below.
snowfield[flakesize_, size_, num_] :=
Module[{x = 100/flakesize},
ImageData@
Image[Graphics[{White,Opacity[.8],
Table[Translate[
Rotate[flake, RandomReal[{0, \[Pi]/6}]], {RandomReal[{0, x}],
RandomReal[{0, x}]}], {num}]}, Background -> Black,
PlotRange -> {{0, x}, {0, x}}], ImageSize -> {size, size}]];
and by 3 different sizes given here:
size=455;
r=snowfield@@@{{.9,size,250},{1.2,size,30},{1.6,size,10}};
So we sort of have 3 different fields of vision reproaching the observer. The 1st observation is simulated with different speed with which different fields of vision are rotated, the closer one being the fastest. This simulates rotation of the fields of vision and builds the frames for the snowfall:
snowFrames=ParallelTable[Image[Total[(RotateRight[r[[#]],k #]&/@{1,2,3})[[All, ;;size]]]],{k,0,455,2}];
## The Postcard
Slight opacity is needed to to blend The Tree and The Snow appealingly. The opacity is given the snowflakes in the code above and `SetAlphaChannel` below is formally needed for image data to have the same dimensions (3 RGB + 1 Opacity channels) and to be able to combine. This builds the final frames
finalFrames=
Parallelize[MapThread[
ImageAdd[SetAlphaChannel[#1,1],#2]&,
{treeFrames,snowFrames}]];
and this exports the frames to the GIF you see at the top of the post:
Export["xmas.gif", finalFrames,"AnimationRepetitions"->Infinity]
I hope you had fun. Feel free to share your own crafts. Happy holidays!
[at0]: https://community.wolfram.com/web/swoods1
[at1]: https://community.wolfram.com/web/wyelen
[1]: https://www.wolframcloud.com/objects/wolfram-community/The-Mathy-Arts-of-Coding-Postcards-by-Vitaliy-Kaurov
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=8701ezgif.com-optimize.gif&userId=11733
[3]: https://mathematica.stackexchange.com/a/16889/13
[4]: https://redd.it/1tswai
[5]: https://community.wolfram.com/groups/-/m/t/175891
[6]: https://en.wikipedia.org/wiki/File:ComplexSinInATimeAxe.gif
[7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ComplexSinInATimeAxe.gif&userId=11733
[8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=534yrsgfdgbd.png&userId=11733
[9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=435wyrhgsfdasaW.png&userId=11733Vitaliy Kaurov2018-12-12T00:56:35ZGet step by step solution of this differential equation with W|A?
https://community.wolfram.com/groups/-/m/t/1569498
When I enter the following ode y''''+8y''+16y=e^t+e^(2t), wolfram alpha doesn't load all steps for me (clicking the button 'show all steps'). Is it just me or is it a general problem.
EDIT: Single steps are working but not all of them are loading. It usually stops after step 14 for me.Agre agrem2018-12-11T17:03:23Z[✓] Use a Wolfram Language equivalent to Matlab "linspace" function?
https://community.wolfram.com/groups/-/m/t/1568743
Hello
Matlab has a built in function called `linspace`, that, according to the documentation, generates a linearly spaced vector, but "gives direct control over the number of points and always includes the endpoints".
Mathematica doesn't work with vectors, rather with lists, but I wish to generate a list of numbers that start from `x1` and ends at `x2`, with `n` points in between (such that the spacing between the points is (x2-x1)/(n-1).
I couldn't find help with `Table`. `Table` generates a list of numbers with a starting point and an end point, with an extra option for the intervals, but I want to have `n` numbers in between.
Is there any work around?Ehud Behar2018-12-10T17:48:09ZAdjusting axis labels font size, but not tick marker size
https://community.wolfram.com/groups/-/m/t/1567112
Hi all! I am looking to change the size of my axis labels to make them slightly larger. The issue I am running into is that when I set the axis labels font size, it also changes the tick marker number font size. I have a line setting the tick marker size to what I want, it seems to be overridden though. Also, I am not sure why but despite all having the same font sizes set for each figure, the frame tick numbers are different sizes between figures. Not really sure what is going on, any help is appreciated. Here is the relevant code.
padding = {{60, 60}, {60, 10}};
a1 = ListLinePlot[Thread[{#, {##2}}] & @@@ gkinA // Transpose,
Frame -> True,
FrameLabel -> {{"Fractional Coverage", None}, {"Time", None}},
PlotLabel -> "Coverage Evolution",
ImagePadding -> padding,
PlotStyle -> {{Red, Thickness[0.01]}, {Blue,
Thickness[0.01]}, {Black, Thickness[0.01]}},
LabelStyle -> {FontFamily -> "Arial", FontSize -> 18, Black},
GridLines -> Automatic,
FrameTicksStyle -> Directive[Black, 15],
PlotRange -> {{0, 26000}, {0, 1}},
ImageSize -> {500, 500}];
b1 = ListLinePlot[Thread[{#, {##2}}] & @@@ gkinB // Transpose,
Frame -> True,
FrameLabel -> {{None, None}, {"Time", None}},
PlotLabel -> "Coverage Evolution",
ImagePadding -> padding,
PlotStyle -> {{Red, Thickness[0.01]}, {Blue,
Thickness[0.01]}, {Black, Thickness[0.01]}},
LabelStyle -> {FontFamily -> "Arial", FontSize -> 18, Black},
FrameTicksStyle -> {{Directive[FontOpacity -> 0, FontSize -> 0],
Directive[FontOpacity -> 0, FontSize -> 0]}, {Automatic,
Directive[FontOpacity -> 0, FontSize -> 0]}},
FrameTicksStyle -> Directive[Black, 15],
PlotRange -> {{0, 38000}, {0, 1}},
GridLines -> Automatic,
FrameTicks -> {{Automatic,
Automatic}, {{0, 5000, 15000, 25000, 35000}, Automatic}},
ImageSize -> {500, 500}];
GraphicsGrid[{{a1, b1}, {a2, b2}, {a3, b3}}, Spacings -> {-75, -170}]Sean Morgan2018-12-06T15:56:46ZVigenere Cryptosystem
https://community.wolfram.com/groups/-/m/t/1568246
Does anyone know how to create a Vigenere Cryptosystem on Mathematica? I'm attempting to encrypt and decrypt a message. I haven't found any tutorials.D William2018-12-08T19:57:05ZRaspberryPi 3 Model B+ and I2C issue
https://community.wolfram.com/groups/-/m/t/1431827
Hello,
I have been struggling with SenseHAT and Mathematica. First Mathematica was not able to find SenseHAT at all even than I followed I2C setup guide but eventually after adding following line to /boot/config.txt I was able to make some progress:
dtparam=i2c0=on
After that there is two i2c buses in the system:
pi@raspberrypi:~ $ ls -l /dev/i2c-*
crw-rw---- 1 root i2c 89, 0 Aug 30 21:34 /dev/i2c-0
crw-rw---- 1 root i2c 89, 1 Aug 30 21:34 /dev/i2c-1
However Mathematica reports variety I2C errors:
pi@raspberrypi:~ $ wolfram
Wolfram Language 11.3.0 Engine for Linux ARM (32-bit)
Copyright 1988-2018 Wolfram Research, Inc.
In[1]:= sensehat = DeviceOpen["SenseHAT"]
Out[1]= DeviceObject[{SenseHAT, 1}]
In[2]:= DeviceRead[sensehat, "Temperature"]
DeviceWrite::unknownMRAAWriteError: An unknown error occured writing to the I2C bus.
DeviceWrite::unknownMRAAWriteError: An unknown error occured writing to the I2C bus.
DeviceWrite::unknownMRAAWriteError: An unknown error occured writing to the I2C bus.
General::stop: Further output of DeviceWrite::unknownMRAAWriteError
will be suppressed during this calculation.
Out[2]= 42.4979 degrees Celsius
when investigating further linux journal it seems that libmraa (presumably of Mathematica MRAALink) tries to use I2C-0 bus:
Aug 30 21:38:05 raspberrypi libmraa[1037]: libmraa version v1.6.1 initialised by user 'pi' with EUID 100
Aug 30 21:38:05 raspberrypi libmraa[1037]: libmraa initialised for platform 'Raspberry Pi Model B Rev 1'
Aug 30 21:38:05 raspberrypi libmraa[1037]: i2c_init: Selected bus 0
Aug 30 21:38:22 raspberrypi libmraa[1037]: i2c0: write: Access error: Remote I/O error
Aug 30 21:38:22 raspberrypi libmraa[1037]: i2c0: write: Access error: Remote I/O error
However as far as I can tell the SenseHAT is in i2c bus 1. So I removed "dtparam=i2c0=on" and after reboot added symbolic link for i2c-0 from i2c-1:
pi@raspberrypi:/ $ ls -la /dev/i2c-*
lrwxrwxrwx 1 root root 10 Aug 30 21:43 /dev/i2c-0 -> /dev/i2c-1
crw-rw---- 1 root i2c 89, 1 Aug 30 21:41 /dev/i2c-1
and tried again SenseHAT in Mathematica which seems to work now:
pi@raspberrypi:/ $ wolfram
Wolfram Language 11.3.0 Engine for Linux ARM (32-bit)
Copyright 1988-2018 Wolfram Research, Inc.
In[1]:= sensehat = DeviceOpen["SenseHAT"]
Out[1]= DeviceObject[{SenseHAT, 1}]
In[2]:= DeviceRead[sensehat, "Temperature"]
Out[2]= 38.9896 degrees Celsius
So for me it looks that Matkematica uses wrong I2C bus at least in this particular model:
pi@raspberrypi:/dev $ cat /proc/device-tree/model
Raspberry Pi 3 Model B Plus Rev 1.3
pi@raspberrypi:/ $ cat /etc/os-release
PRETTY_NAME="Raspbian GNU/Linux 9 (stretch)"
NAME="Raspbian GNU/Linux"
VERSION_ID="9"
VERSION="9 (stretch)"
ID=raspbian
ID_LIKE=debian
HOME_URL="http://www.raspbian.org/"
SUPPORT_URL="http://www.raspbian.org/RaspbianForums"
BUG_REPORT_URL="http://www.raspbian.org/RaspbianBugs"
I think this should be fixed to Mathematica.Teemu Ahola2018-08-30T18:49:14ZWhere can I find documentation on "StyleHints"?
https://community.wolfram.com/groups/-/m/t/1557788
I've done some searching but I can't seem to find any documentation on "StyleHints". I'm using 11.3 on OS X High Sierra and there doesn't seem to be any built-in documentation. A search on this site also didn't turn up much. Is there any formal documentation? Has anyone posted a tutorial somewhere?
Thanks.Andrew2018-11-22T22:15:46ZSearching for collaborators about image tiling
https://community.wolfram.com/groups/-/m/t/1568407
Symmetry and symmetry breaking is a central topic of my artistic work. I am fascinated by image tiling as a source of symmetry but until recently the situation was not different than 25+ years ago when my interest started with the Photoshop plugin Terrazzo: There are thousands of known euclidean tilings ([Tiling Database][1]) but only the basic 17 wallpapergroups were used for image tiling.
I am working on a general approach to change this: Every image tiling or image pattern in general can be made by one or more proto-tiles (rectangle or masked polygon shaped images with transparency) and a list of clone-, rotate-, mirror- (flip,flop), and translate-commands collected in a CRMT command list. A CRMT interpreter would take such a list and a set of proto-tiles and generate an image tiling, ornament or pattern by step-by-step processing the commands.
For example the following CRMT command list is coding the 14 processing steps to generate a p3m1 tile from a given equilateral triangle proto-tile image (see my p3m1-examples using this CRMT approach on [p3m1-CRMT album 1][2] and [p3m1-CRMT album 2][3]):
C0, x0, y0, C0, Fo, R-60, x-1/2*t_w, y0, C0, Fo, R60, x1/2*t_w, y0, C0, Fo, R-60, Fi, xt_w, y0, C0, Fi, x3/2*t_w, y0, C0, Fo, R60, Fi, x2*t_w, y0, C0, Fo, R-60, x5/2*t_w, y0, C0, Fi, x0, yt_h, C0, Fo, R-60, Fi, x-1/2*t_w, yt_h, C0, Fo, R60, Fi, x1/2*t_w, yt_h, C0, Fo, R-60, xt_w, yt_h, C0, x3/2*t_w, yt_h, C0, Fo, R60, x2*t_w, yt_h, C0, Fo, R-60, Fi, x5/2*t_w, yt_h
The operation sequence for one proto-tile processing like "C0, Fo, R-60, x-1/2*t_w, y0" is interpreted as: clone the first (starting with 0) element in the proto-tile list, flop it, rotate it 60 degrees counterclockwise (+ trim), make a translation in x-direction with floor(-1/2*t_w) where t_w is the width of the equilateral triangle, make a translation in y-direction with 0 and then compose the proto-tile over the tile background which is in the p3m1 case a black image with an (2*t_h, 3*t_w) area were t_h = 1/2*sqrt(3)*t_w.
![p3m1 CRMT example from my art][4]
Additionally the CRMT interpreter also needs a list with coordinates for one or more masks that must be draw because the masked proto-tiles must come somewhere; in the p3m1 case the x and y coordinates of the triangle are: x_coord = [0 t_w t_w/2]; y_coord = [0 0 t_h];
Such an approach is not fast but universal and because of the no-overlap condition of tilings the processing steps for one proto-tile are independent and therefore the 14 steps in the p3m1 case could be made in parallel. And there is always the option to optimize some specific tiling by using some knowledge about its structure. In the p3m1 case run-time can be saved by the knowledge that the lower half is a flipped version of the upper half.
To further develop the CRMT approach I am searching for
**1) programmer implementing CRMT interpreter in different environments like Mathematica**
Programming a CRMT interpreter seems neither a difficult nor a too costly task because the core is some string processing combined with calling some image processing functions. And if the used environment has RGBA abilities and boundary methods like "-virtual-pixel mirror" (ImageMagick function) or simple inpainting functions it makes everything much easier because composing polygon shaped images results in artifacts at the edges if non-90 degree polygon-masks were used.
There is active development in other environments underway: I have programmed a batch processing prototype in Matlab and a first prototype for a CRMT filter in G'MIC was published this week ([G'MIC][5], [discussion about the G'MIC CRMT filter][6]).
**2) people writing their own CRMT lists**
Every high school kid with basic trigonometry knowledge can determine the angles, lengths and distances in a given tiling image from the Tiling Database to write a CRMT-list without any knowledge of a specific programming language or image processing, so there is potential a huge community. It is only a question of persistence to code even the most complex periodic tilings like [Islamic patterns][7].
Math teachers are often looking for something motivational. Real world applications and aesthetics in math (see [Bridges conferences][8]) are mostly the areas they come up with and I think that image tiling is an excellent example for the later. Writing a CRMT command list for a tiling would be a nice assignment if intermediate states could immediately be checked for feedback with a CRMT interpreter. And there is the general question about meaning and sustainability of assignments: Making the first command list for a tile is a meaningful and sustainable activity because such a list can generate aesthetic images even decades later independent of whatever programming languages will be used then for a CRMT interpreter.
**Future perspectives**
Using trigonometry to extract information from given tilings, ornaments and patterns will restrict the audience mostly to academia and math enthusiasts. A much wider audience would be reached with a GUI based system where proto-tiles are placed with drag&drop. Combined with an interaction log that records the relevant actions and a CRMT optimizer that combines all the actions related to one proto-tile to one command set a CRMT-list for a pattern should be reconstructible. I am thinking about modifying this [Mathematica demonstration][9]. If in a long-term perspective AI-agents with a learned sense for symmetry and aesthetic can play such a system an endless stream of interesting pattern descriptions would be accessible that can directly be used in every environment with a CRMT interpreter.
The CRMT approach is also extendible in many directions for example by simply adding a new command type like "S" for scaling which makes image types like euclidean [Fractal Tiling][10], Iterated Function Systems and [orbit trapping][11] accessible.
[1]: http://www.tilingsearch.org/
[2]: https://www.flickr.com/photos/gbachelier/albums/72157673790864417
[3]: https://www.flickr.com/photos/gbachelier/albums/72157674278683877
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=32230404598_168f19be34_k.jpg&userId=753358
[5]: https://gmic.eu
[6]: https://discuss.pixls.us/t/collaborators-for-image-tiling/9966/24
[7]: https://patterninislamicart.com/drawings-diagrams-analyses/1/elements-art-arabe
[8]: http://bridgesmathart.org/
[9]: http://demonstrations.wolfram.com/TilingConstructorTileDraggingVariant/
[10]: https://www.mathartfun.com/encyclopedia/encyclopedia.html
[11]: http://2008.sub.blue/projects/fractal_explorer.htmlGuenter Bachelier2018-12-09T13:46:51ZFind all roots of the following equation?
https://community.wolfram.com/groups/-/m/t/1568356
I'm currently doing some Mathematica exercises, and I'm stuck on this one task where you're supposed to plot the functions h(t)= |3-t^2|+|t-1|-t^2 , g(t)=3sin(t) in the same grap, and then find all the roots. This is what I've got so far:
![enter image description here][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=UHvxo.png&userId=1540567
The instructions say that I should use FindRoot to exactly decide all the roots, but I don't think I've done it right. What should I change with the function in order to make it find all of the roots?
Thanks in advance.Jhn Snd2018-12-09T11:50:45ZImprove code for finding the coordinates of a triangular mesh?
https://community.wolfram.com/groups/-/m/t/1567948
Hello, The problem of finding the coordinates of a triangular (equilateral) mesh discussed earlier is solved. It also counts the number of equilateral triangles formed by the intersecting parallel lines. But the problem is that the code takes more time for larger values of n i.e. the size of the side of the triangle. Can the code be improved? The code is given here. Thanks for any suggestion.
n = 4;
Print["Number of lines/size of triangle = ", n]
h = Sqrt[3] /2;
Array[x, n];
Array[s, n];
x[0] = {{n/2, n h}};
For[i = 1, i <= n, i++,
x[i] = Table[{x[0][[1, 1]] - i/2 + j, n h - i h}, {j, 0, i}]];
set = Apply[Union, Table[x[i], {i, 0, n}]];
Print["Number of vertices = ", Length[set]]
cond := (EuclideanDistance[#[[1]], #[[2]]] ==
EuclideanDistance[#[[2]], #[[3]]] ==
EuclideanDistance[#[[1]], #[[3]]] && #[[1]] != #[[2]] != #[[
3]] && #[[1, 1]] < #[[2, 1]] < #[[3,
1]] && (#[[1, 2]] == #[[2, 2]] || #[[2, 2]] == #[[3, 2]] || #[[
3, 2]] == #[[1, 2]]) &)
tr0 = Tuples[set, 3];
tr1 = Select[tr0, cond];
Print["Number of Triangles = ", Length[tr1]]jagannath debata2018-12-09T07:39:12ZFormat the line spacing of an input cell?
https://community.wolfram.com/groups/-/m/t/1558301
In 11.3 on OS X High Sierra, if I want to change the font size of the code in an input cell, I can easily do that with the notebook's stylesheet by choosing the "Input" style and using the Option Inspector to change the font size.
However, when I try to adjust the line spacing, the same approach does not work (it's as if the LineSpacing option under "Text Layout Options" has no effect).
I can change the line spacing by editing the cell directly, using Cell->Show Expression and manually typing in the option
LineSpacing->{1,0}
But I don't want to do this manually for all Input cells. I suspect there must be some other way to control the line spacing for all Input Cells in a notebook, but I can't find where it is documented. Any pointers would be appreciated.
Thanks.Andrew2018-11-22T23:06:12ZPlot Poincare map in order to analyze chaos?
https://community.wolfram.com/groups/-/m/t/1567675
Consider the following code:
U[t] + 3 U[t]^2 + 6 V[t] + 3 V[t]^2 + 5 W[t] + 2 W[t]^2 + 4 U[t]*V[t] == 2 U'[t] ;
6 U[t] + 3 U[t]^2 + 3 V[t] + 4 V[t]^2 + 8 W[t] + 4 W[t]^2 + 3 U[t]*V[t] == V'[t];
5 U[t] + 3 U[t]^2 + 5 V[t] + 3 V[t]^2 + 8 W[t] + 4 W[t]^2 + 8 U[t]*V[t]+ Q*Sin[100*t] == W'[t] + 2 W''[t];
U[0] == V[0] == W[0], U'[0] == V'[0] == W'[0]==0.0001
Q=const
I need to plot a Poincare map with W [t], W '[t]. I am having trouble. I thank everyone.Vũ Ngọc Việt Hoàng2018-12-08T07:33:18ZFind "CDF Export" in File submenu in MMA 11.3 (Windows)?
https://community.wolfram.com/groups/-/m/t/1568136
I am new to Mathematica, and I am using Mathematica 11.3 (Windows). The documentation refers to a "CDF Export" sub menu item from the file menu.( File --> CDF Export). I do not have a CDF export menu as a submenu on my File menu. Thanks for any heip.Thomas Seibel2018-12-08T16:05:41Z[✓] Use NMinimize calling an own defined function?
https://community.wolfram.com/groups/-/m/t/1567463
I want to call an own defined function through NMinimize. For the sake of simplicity, let us define the problem as follow:
radpatt[x1_] := (Print[x1]; x1 )
NMinimize[{radpatt[xx], 0.1 <= xx <= 1.1}, {xx}]
If you run the above-listed instructions, you will notice that x1 is not number as soon as the function radpatt is called by NMinimize, but it is equal to xx. This causes me an issue because in my original problem x1 needs to be a number just at the beginning of my own function. Any ideas?
Many many thanks in advance.Mario Junior Mencagli2018-12-08T06:23:38ZUse CUDA functions in Mathematica 11.3?
https://community.wolfram.com/groups/-/m/t/1567399
Hi,
I previously had Mathematica 11.0.0 and I successfully used it with my NVIDIA GT 630M GPU on my DELL Inspiron through CUDALINK. I am using Windows 10 Professional.
I now have installed Mathematica 11.3. To my surprise, CUDA functions have stopped working.
Although `CUDAQ[]` Returns `True` and `CUDAResourcesInformation[]` returns:
CUDAResourcesInformation[]
{{"Name" -> "CUDAResources", "Version" -> "11.3.82",
"BuildNumber" -> "", "Qualifier" -> "Win64",
"WolframVersion" -> "11.2,11.3", "SystemID" -> {"Windows-x86-64"},
"Description" -> "{ToolkitVersion -> v9.1, MinimumDriver -> 290}",
"Category" -> "", "Creator" -> "", "Publisher" -> "",
"Support" -> "", "Internal" -> False,
"Location" ->
"C:\\Users\\DELL\\AppData\\Roaming\\Mathematica\\Paclets\\\
Repository\\CUDAResources-Win64-11.3.82", "Context" -> {},
"Enabled" -> True, "Loading" -> Manual,
"Hash" -> "8e54b1af34017668d20caeae2d6e364d"}}
The graphics card driver is the latest for my card:
CUDADriverVersion[]
391.35
Running, for example, `CUDADot[]` gives an error
CUDADot[{1,2,3},{3,4,5}]
CUDAQ::internal: CUDALink experienced an internal error.
What seems to be the problem here? Do I need to install and configure a C Compiler so that `CUDACCompilers[]` does not return an empty list?Hamood Khan2018-12-07T13:30:01ZMake a Sous Vide using Raspberry Pi and Mathematica?
https://community.wolfram.com/groups/-/m/t/1563105
Hello, I am trying to make a Sous Vide using Raspberry Pi and Mathematica. I am in the process of collecting everything I need but am not sure which Pi to get. Can anyone tell me what model I need? (I am following the article posted by Liz Upton)George Saucedo2018-11-30T17:56:32ZSolve the differential equation by Runge Kutta method?
https://community.wolfram.com/groups/-/m/t/1563269
I need to solve the equation as follows by numerical methods such as Runge Kutta, Newton Raphson, ... Hope everyone help me. I thank everyone.
![enter image description here][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Untitled.png&userId=1563397Vũ Ngọc Việt Hoàng2018-12-01T15:10:42ZGet formula to calculate text rotation angle (clock angle problem)?
https://community.wolfram.com/groups/-/m/t/1567764
Hello.
Let's say we have circle. We cut it to 4 'triangles' but longest hand is perfect arc. I want to write some letters on this arc but rotate it to be horizontal always.
In other words, how to make clock face with horizontal numbers. It can be any hour, so can be 12-3-6-9, but can be 1-4-7-11 etc.
Thanks for suggestions.John Cosmic2018-12-08T00:16:55ZFeature Request - add Rust to EmbedCode and ExternalEvaluate
https://community.wolfram.com/groups/-/m/t/1566948
Greetings to all,
Not sure if this is the space to create feature requests, but I figured I'd give it a try.
For my security and low-level device work, it wasn't until the 11.3 version of the Wolfram Language that it became a viable stack.
Stephen and Co. have managed to cover with WL a great deal of situations and platforms. What I'd like to see now is extend that functionality further by including support for Rust and bring it up to par with other already included environments. Rust's light footprint, security emphasis and the fact that it doesn't require a runtime - let's not forget it's also super fast - make for a great addition.
$EmbeddedCodeEnvironments
{Android, C#, C++,VisualStudio, GoogleDocs, HTML, Java, Java-Jersey, Javascript, Perl, PHP, Python, Ruby, Scalia, VisualBasic}
I mean, look at the cool stuff one can do with EmbedCode
https://reference.wolfram.com/language/ref/EmbedCode.html
With ExternalEvaulate I could use WL to develop and create Rust/WL functions that run on AWS Lambda and small micro controller platforms. A match made in heaven. Did I mention WebAssembly?
https://reference.wolfram.com/language/ref/ExternalEvaluate.html
This type of functionality would be worth the price of a license all by itself. Just asking!
Thanks,
JoseJose M.2018-12-06T19:03:04Z[✓] Import data into the right format (ex: E+-03 -> 10^3)?
https://community.wolfram.com/groups/-/m/t/1567362
Hi.
I have a question about data import.
My data represent 10^3 as E+03.
So, If I import data, Mathematica can't get a handle on E+03.
How can I solve this problem?
Thanks.Myunghwan Kim2018-12-07T08:24:43ZDraw multiple bar chart labels?
https://community.wolfram.com/groups/-/m/t/1567723
I am drawing a Bar Chart using this code:
outlabels={"Label1(1-10)", "Label1(11-20)", "Label1(21-30)"};chartouttable={{1, 1, 1}, {2, 3, 2}, {1, 1, 1}};BarChart3D[chartouttable, ChartLayout -> "Grid",
ChartLabels -> Placed[outlabels, Center]]
And I get:
![enter image description here][1]
1. The problem is that each label is on there three times. I know that
I can put them on the Axis to only show them once but I want them on
the side of the first series and vertical if possible and only once.
Is there a way to do this?
2. Also, I would like to add labels to the
series axis but can't figure how to. How can that be done?
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=4034BarChart.jpg&userId=1523039Jamie Dixson2018-12-07T16:45:42Z[✓] Use series as Z on 3D Bar Chart?
https://community.wolfram.com/groups/-/m/t/1567386
I need individual series to be shown on the Z axis in a 3D bar chart. However, when I I use BarChart3D it places the series side-by-side. The documentation has a weather chart example but it is hard to understand how they got what they did without knowing something about their actual data. This is what I have that is not right:
BarChart3D[{{1, 2, 3, 4}, {4, 3, 2, 1}, {3, 2, 1, 4}}]
And it produces a chart that looks like:
![enter image description here][1]
However, I need a chart that looks like:
![enter image description here][2]
I know this is probably just a styling option but I cannot find it in the documentation.
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=BarChart.jpg&userId=1523039
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=BarChart2.jpg&userId=1523039Jamie Dixson2018-12-07T12:15:01ZDynamically create a list of strings for chart labels?
https://community.wolfram.com/groups/-/m/t/1567311
I am attempting to dynamically create a list that will serve as labels for a chart. The list will be based on a name which the user inputs for a list and the range of elements from the list. I can't seem to get the While loop to work just right. What am I doing wrong? What I have so far is:
seq1 = {52.000, 52.289, 39.000,
0.000, -10.121, -19.000, -22.000, -28.203, -18.000, -6.000, -5.615,
0.000, 0.000, 1.770, 2.000, 4.000, 3.903,
2.000, -4.000, -3.729, -3.000, 4.000, 20.378, 20.000, 47.000,
74.958, 58.000, 54.000, 68.563, 40.000};
window = 10;
offsetwindow = 5;
wordseqname = "Lab1";
stopper = Length[Partition[seq1, window, window]]; st = 0; While[
st <= stopper,
outlabel =
wordseqname <> "_(" <> st*window + 1 <> "-" <> st*window + 1 +
window; st++]
The output needs to be:
outlabel={"Lab1 (1-10)","Lab1 (11-20)","Lab1 (21-30)"}Jamie Dixson2018-12-07T04:16:57ZCan Wolfram´s Mathematica read CmapTools files?
https://community.wolfram.com/groups/-/m/t/1567561
Hi,
I would like to analyze CmapTools Concept Maps using Wolfram´s Mathematica. I intend to use graph theory to analyze the maps but I don´t know if Mathematica can read CmapTools files or if I have to convert them to a different format. Does anyone have experience with that or have any idea about it?
RibasJose Ribamar2018-12-07T11:30:00ZDownload manager won't start downloading and displays errors
https://community.wolfram.com/groups/-/m/t/1211541
Hello everyone!
Could anyone please help me with this situation? I am trying to download the latest version of Mathematica, but I am having this problem with download manager utility and I can't find any solution. The download process nevers starts and I only see those error messages...
![enter image description here][1]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=helpmeifyoucan.png&userId=1211525
I would really appreciate some explanation for fixing this, thanks a lot :)
(2 hours after creating this thread Update) - **Timeout in I/O** has just been replaced by **Socket error** :(Samuel Čech2017-10-31T18:31:36ZUse NMinimize calling a own defined function with FindRoot?
https://community.wolfram.com/groups/-/m/t/1567276
I defined my own function which solves a transcendental equation by using a findroot, and it works. But, when I call my own defined function with NMinimize, it gives me an error. I do not understand where it comes from. Attached please find my code. Please let me know if you know where the problem might be.Mario Junior Mencagli2018-12-07T05:10:37Z[✓] Use Map with If to apply a test to a nested list?
https://community.wolfram.com/groups/-/m/t/1566989
I have the nested list:
outtable={{2936.43, 2010.95, 805.145}, {1277.23, 646.763, 40.0572}, {11.9107,
28.5548, 52.7854}, {14.1702, 1305.69, 1775.71}, {412.422, 773.669,
726.661}}
I would like to apply a test to the list and output a table of identical dimensions but with "1" if the value in the list is less than a threshold value and 0 if it is not. Here is what I have tried:
threshold = 50;
outtable2 = Map[[If[[#] <= threshold, 1, 0]], outtable]
The output should look like this:
outtable2={{0,0,0},{0,0,0},{1,1,0},{1,0,0},{0,0,0}}
Any help with getting this to work would be appreciated.Jamie Dixson2018-12-07T01:29:48Z[✓] Get nested table data in right place?
https://community.wolfram.com/groups/-/m/t/1566967
I am trying to get a nested table but my code gives the output matrix with the right dimensions but the data in the wrong place. My code is:
seq1 = {52.000, 52.289, 39.000,
0.000, -10.121, -19.000, -22.000, -28.203, -18.000, -6.000, -5.615,
0.000, 0.000, 1.770, 2.000, 4.000, 3.903,
2.000, -4.000, -3.729, -3.000, 4.000, 20.378, 20.000, 47.000,
74.958, 58.000, 54.000, 68.563, 40.000, 50};
seq2 = {52.000, 52.289, 39.000, -12.000, -1.792, -6.000, 49.000,
69.931, 59.000, 24.000, 27.989, 7.000, 7.000, 21.857, 18.000,
41.000, 55.666, 41.000, 18.000, 33.127, 18.000, 41.000, 57.813,
43.000, 25.000, 28.099, 11.000, 2.000, -2.715, -6.000};
window = 10;
offsetwindow = 5;
coltot = IntegerPart[Length[seq1]/window]
rowtot = Length[Partition[seq2, window, offsetwindow]]
dist1 = Tuples[{Partition[seq1, window, window],
Partition[seq2, window, offsetwindow]}]
outtable =
Table [CanonicalWarpingDistance[dist1[[i, 1]], dist1[[i, 2]],
Automatic, {"SlantedBand", 950},
Method -> {"MatchingInterval" -> "Flexible"},
DistanceFunction -> CosineDistance], {i, 1, rowtot}, {j, 1,
coltot}]
The output is:
{{2936.43, 2936.43, 2936.43}, {2010.95, 2010.95, 2010.95}, {805.145,
805.145, 805.145}, {1277.23, 1277.23, 1277.23}, {646.763, 646.763,
646.763}}
But it should be:
{{2936.43,2010.95,805.145},{1277.23,646.763,40.0572}, {11.9107, 28.5548, 52.7854}, {14.1702, 1305.69, 1775.71},{412.422, 773.669, 726.661}}
I verified the values by running the code with output as an unnested list and the total list of output values are:
{2936.43, 2010.95, 805.145, 1277.23, 646.763, 40.0572, 11.9107, \
28.5548, 52.7854, 14.1702, 1305.69, 1775.71, 412.422, 773.669, \
726.661}
I just need them in matrix form. In this particular case it should be a 3X5 matrix but that will change depending on the input variables seq1 and seq2. The size of the matrix will be "rowtot" X "coltot." Where am I going wrong?Jamie Dixson2018-12-06T23:06:54Z