RandomReal[{1,100}]

RandomReal[{1,100},{12}]

RandomReal[{1,100},{4,4}]

Det[%]

Table[(1/(i+j-1)),{j,4},{i,4}]

HilbertMatrix[4]

{1,2,3,4,5}+{2,4,6,8,10}

{1,2,3,4,5}{2,4,6,8,10}

Dot[{1,2,3,4,5},{2,4,6,8,10}]

{1,2,3,4,5}.{2,4,6,8,10}

Range[25]

Range@25

25//Range

Table[i,{i,1,25}]

Table[Binomial[n,1],{n,1,25}]

series=Series[(1/(((1-x))^2)),{x,0,24}]

CoefficientList[Normal[series],x]

Sum[i,{i,(10^3)}]

(∑_i^(10^3))i

ParallelSum[i,{i,(10^3)}]

i=0;
Do[i=i+j,{j,(10^3)}];
i

res=0;
i=0;
For[i=1,i≤(10^3),i++,res=i+res];
res

res=0;
i=0;
While[i≤(10^3),res=i+res;i++];
res

lis=Range[(10^3)];

Apply[Plus,lis]

Fold[Plus,0,lis]

Last[Accumulate[lis]]

Total[lis]

s[0]=0;
s[n_]:=s[n]=s[n-1]+n

s[1000]

lis/.{x_,y__}:>x+y

mat=SparseArray[{i_,i_}:>lis[[i]],{(10^3),(10^3)}];
Tr[mat]

n=(10^3);
Binomial[n+1,2]

mat={{3,5},{1,2}};

Inverse[mat]

Det[mat]

Transpose[mat]

Tr[mat]

mat={{1,1},{1,0}};

Inverse[mat]

Det[mat]

Transpose[mat]

mat.mat.mat.mat.mat

MatrixPower[mat,5]

MatrixPower[mat,100]

Fibonacci[101]

Clear[s,lis,mat,n,i,res]

expr=LegendreP[5,x]

FullForm[(12/4)]

{AtomQ[8/5],Head[8/5]}

{AtomQ[8/5+x],Head[8/5+x],FullForm[8/5+x]}

{AtomQ[{{a,b},{c,d}}],Head[{{a,b},{c,d}}]}

{AtomQ["8/5+x"],Head["8/5+x"]}

Times[a,Power[Plus[b,c],-1]]

expr=a (x^2)+b x+c;

FullForm[expr]

expr[[2]]

expr[[2,1]]

FullForm[((((x^2)+y) z)/w)]

((((x^2)+y) z)/w) [[2, 1, 2]]

FullForm[a/b]

(a/b)[[2,2]]

expr=LegendreP[5,x]

Level[expr,2]

Level[expr,{2}]

Defer[FullForm[12/4]]

dirs={{0,1},{0,-1},{1,0},{-1,0}};

RandomChoice[dirs]

RandomChoice[dirs,5]

Accumulate[%]

ListLinePlot[Accumulate[RandomChoice[dirs,25000]],PlotStyle->Thin]

vec=RandomReal[{0,1},8]

ToCharacterCode["A"]

data=RandomReal[{0,1},{(10^4)}];
Histogram[data,15]

RandomVariate[BernoulliDistribution[p],n]

NumericQ[2+π]

NumberQ[2+π]

2^^1000001

BaseForm[65,2]

complexToPolar[z_]:={Abs[z],Arg[z]}

complexToPolar[3+3 I]

AbsArg[3+3 I]

complexToPolar[(E^((π I)/3))]

AbsArg[(E^((π I)/3))]

pi=N[π,20]

NumberForm[pi,{4,3}]

vec=RandomReal[{0,1},8]

PaddedForm[vec,{3,2}]

RealDigits[N[π]]

First[%]

pidigs=First[RealDigits[N[π,(10^5)]]];

Histogram[pidigs]

ToCharacterCode["Apple"]

IntegerDigits[%,2]

IntegerDigits[ToCharacterCode["Apple"],2,8]

n=5;
vertices=Range[5]

edgesCG=EdgeList[CompleteGraph[n]]

RandomChoice[edgesCG,8]

RandomSample[edgesCG,8]

n=13;
m=15;
Graph[Range[n],RandomSample[EdgeList[CompleteGraph[n]],m]]

n=21;
m=167;
Graph[Range[n],RandomSample[EdgeList[CompleteGraph[n]],m]]

RandomGraph[{21,211}]

Binomial[21,2]

RealDigits[N[1/17,20]]

First[%]

digs=First[RealDigits[N[1/17,5000]]];

ListPlay[digs]

data=RandomReal[{0,1},{(10^4)}];

Histogram[data,10]

{Histogram[(data^1.5),10,ImageSize->160],Histogram[(data^2),10,ImageSize->160]}

data=RandomVariate[BenfordDistribution[10],{(10^4)}];
Histogram[data,10]

(({a,b,c,d,e})^1.5)

trials=10000;
incr=0.001;
info=Table[{p,Entropy[2,RandomVariate[BernoulliDistribution[p],trials]]},{p,0,1,incr}];

ListPlot[info,AspectRatio->1,GridLines->Automatic]

f[n_]=Sum[(((1+x))^j),{j,1,n}];

g[n_]:=Sum[(((1+x))^j),{j,1,n}]

f[2]

g[2]

RotateRight[{a,b,c,d,e}]

N[ChampernowneNumber[10],31]

reciprocal[a_/b_]:=b/a

reciprocal[3/4]

FullForm[3/4]

reciprocal[Rational[a_,b_]]:=Rational[b,a]

reciprocal[z_Rational]:=Denominator[z]/Numerator[z]

reciprocal[3/4]

reciprocal[z/(x+y)]

reciprocal[0/5]

sumInts[n_]:=Total[Range[n]]

sumInts[100]

sumInts[1000]

DigitSum[n_]:=Total[IntegerDigits[n]]

DigitSum[10!]

DigitSum[n_,base_:10]:=Total[IntegerDigits[n,base]]

DigitSum[(2^31)-1,2]

DigitCount[(2^31)-1,2,1]

sumsOfCubes[n_Integer]:=Total[((IntegerDigits[n])^3)]

sumsOfCubes[124]

randLis1[n_]:=RandomReal[1,{n}]

randLis1[3]

randLis2[n_]:=(x=RandomReal[];Table[x,{n}])

randLis2[3]

randLis2[3]

randLis3[n_]:=(x:=RandomReal[];Table[x,{n}])

randLis3[3]

randLis4[n_]=Table[RandomReal[],{n}]

Clear[x,n]

f[n_]=Sum[(((1+x))^j),{j,1,n}]

g[n_]:=Sum[(((1+x))^j),{j,1,n}]

Expand[f[2]]

Expand[g[2]]

log[a_*b_]:=log[a]+log[b]

log[((a_)^(n_))]:=n log[a]

log[x (y^2) (z^3)]

log[x/y]

g[x_]:=Piecewise[{{-1(Sqrt[1-(((x+2))^2)]),-2≤x≤-1},{(Sqrt[1-(x^2)]),x<0}}]

Plot[g[x],{x,-2,0}]

IntegerDigits[142857]

RotateRight[IntegerDigits[142857]]

FromDigits[RotateRight[IntegerDigits[142857]]]

IntegerRotateRight[n_Integer]:=FromDigits[RotateRight[IntegerDigits[n]]]

Divisors[IntegerRotateRight[142857]]

MemberQ[Divisors[IntegerRotateRight[142857]],142857]

Select[Range[10,(10^6)],MemberQ[Divisors[IntegerRotateRight[#]],#]&]

Table[Prime[i],{i,10}]

IntegerDigits[%]

Flatten[%]

FromDigits[%]

SmarandacheWellin[n_]:=FromDigits[Flatten[IntegerDigits@Table[Prime[i],{i,n}]]]

Table[SmarandacheWellin[i],{i,10}]

Select[%,PrimeQ]

SmarandacheWellin[1429]//N

PrimeQ[SmarandacheWellin[1429]]

f[x_]:=-1<x<1

f[x_]:=Abs[x]<1

f[4]

f[-0.35]

StringCharacterQ[ch_]:=StringQ[ch]&&StringLength[ch]==1

StringCharacterQ["v"]

StringCharacterQ["vi"]

StringCharacterQ[v]

NaturalQ[n_]:=IntegerQ[n]&&n≥0

NaturalQ[0]

NaturalQ[-4]

SquareNumberQ[n_]:=IntegerQ[(Sqrt[n])]

SquareNumberQ[10]

Select[Range[100],SquareNumberQ]

TriangularNumberQ[t_]:=OddQ[(Sqrt[8t+1])]&&SquareNumberQ[8t+1]

TriangularNumberQ[6]

TriangularNumberQ[55]

TriangularNumberQ[56]

SquareTriangularNumberQ[n_]:=TriangularNumberQ[n]&&SquareNumberQ[n]

Select[Range[1000000],SquareTriangularNumberQ]

RealPositiveQ[n_?NumericQ]:=Im[n]==0&&Positive[n]

Select[{-4,23,3+4I,π},RealPositiveQ]

RealPositiveQ[vec_?VectorQ]:=AllTrue[vec,RealPositiveQ]

RealPositiveQ[{-4,23,3+4I,π}]

Clear[RealPositiveQ];
RealPositiveQ[n_?NumericQ]:=Im[n]==0&&Positive[n]

RealPositiveQ[vec_]:=VectorQ[vec,RealPositiveQ]

ArrayPlot[Boole[Table[CoprimeQ[a,b],{a,100},{b,100}]]]

DenseGraphQ[gr_Graph]:=2EdgeCount[gr]/(VertexCount[gr](VertexCount[gr]-1))≥0.5

gr=RandomGraph[{20,90}]

DenseGraphQ[gr]

CompleteGraph[10]

DenseGraphQ[%]

GraphDensity[CompleteGraph[10]]

GraphDensity[gr]

DenseGraphQ[gr_Graph]:=GraphDensity[gr]≥0.5

g[x_+y_]:=(x^2)+(y^2)

g[2+3]

g[2+3]

reciprocal[Rational[a_,b_]]:=Rational[b,a]

reciprocal[0/5]

ClearAll[g]

SetAttributes[g,HoldAll]

g[x_+y_]:=(x^2)+(y^2)

g[a+b]

g[2+3]

vec=RandomReal[{-1,1},10]

fun[x_?NumberQ,bound_]:=If[-bound<x<bound,x,(Sqrt[x])]

SetAttributes[fun,Listable]

fun[vec,0.5]

reciprocal[z_Rational]:=Denominator[z]/Numerator[z]

reciprocal[0/5]

SetAttributes[reciprocal,HoldAll]

reciprocal[z_Rational]:=Denominator[z]/Numerator[z]

reciprocal[0/5]

FullForm[HoldForm[0/5]]

reciprocal[Times[a_,Power[b_,-1]]]:=b/a

reciprocal[0/5]

reciprocal[2/3]

reciprocal[x/(y+z)]

Clear[f,fun,vec,gr]

Array[f,5]

Array[f,{3,4}]

m=5;
GridGraph[{m,m},VertexLabels->"Name"]

HighlightGraph[
GridGraph[{m,m},VertexLabels->"Name"],
Style[{1,13,25},Red], VertexSize->Medium]

Table[5j,{j,1,100/5}]

Range[5,100,5]

Table[(1/(2^i)),{i,0,16}]

1/(2^Range[0,16])

Table[j,{i,0,8,2},{j,0,i,2}]

Table[2 j,{i,0,4},{j,0,i}]

Table[f[i],{i,5}]

Table[f[i,j],{i,3},{j,4}]

n=4;
Table[1+i+j,{j,0,(n^2)-1,n},{i,0,n-1}]

n=4;
Table[j+k n,{k,0,n-1},{j,1,n}]

MatrixForm[%]

Table[Binomial[5,k],{k,0,5}]

Expand[(((1+x))^5)]

n=6;
Table[Binomial[j,i],{i,0,n-1},{j,i,n+i-1}]

MatrixForm[%]

m=5;
gg=GridGraph[{m,m},VertexLabels->"Name"]

top=Range[m,(m^2),m]

bot=Range[1,(m^2)-m+1,m]

HighlightGraph[GridGraph[{m,m},VertexLabels->"Name"],{Style[bot,Red],Style[top,White]}]

m=7;
top=Range[m,(m^2),m];
bot=Range[1,(m^2)-m+1,m];
HighlightGraph[GridGraph[{m,m},VertexLabels->"Name"],{Style[bot,Red],Style[top,White]}]

images=Map[ExampleData,{{"TestImage","Girl2"},{"TestImage","Peppers"},{"TestImage","Aerial"},{"TestImage","Moon"},{"TestImage","Tank2"},{"TestImage","Ruler"}}];

Map[ImageDimensions,images]

img1=images[[1]];
img2=ImageResize[images[[2]],256];
img3=images[[3]];
img4=images[[4]];
img5=ImageResize[images[[5]],256];
img6=ImageResize[images[[6]],256];

Grid[{
{img1,img2,img3},
{img4,img5,img6}
},Frame->All,Spacings->{1,1},ItemSize->{3,3}]

xmin=-2;xmax=2;ymin=-1;ymax=1;
hlines=Table[{{xmin,y},{xmax,y}},{y,ymin,ymax}]

vlines=Table[{{x,ymin},{x,ymax}},{x,xmin,xmax}]

pairs=Flatten[{hlines,vlines},1]

Graphics[Line[pairs]]

coords=Table[{i,j},{i,1,5},{j,1,3}]

Graphics[Line[coords]]

Transpose@coords

Graphics[Line[Transpose@coords]]

Lattice[{xdim_,ydim_}]:=Module[{coords},
coords=Table[{i,j},{i,1,xdim},{j,1,ydim}];
Graphics[{
Line[coords],Line[Transpose[coords]],
PointSize[Medium],Point[Flatten[coords,1]]
}]]

Lattice[{6,4}]

?CoordinateBoundsArray

coords=CoordinateBoundsArray[{{1,5},{1,3}}]

Dimensions[coords]

Graphics[Line[coords]]

Transpose[coords]

Graphics[{Line[coords],Line[Transpose[coords]]}]

Lattice[{xmin_,xmax_},{ymin_,ymax_}]:=Module[{coords},
coords=CoordinateBoundsArray[{{xmin,xmax},{ymin,ymax}}];Graphics[{Line[coords],Line[Transpose[coords]]}]
]

Lattice[{1,5},{1,3}]

lis=RandomChoice[{.0001,.9999}->{0,1},{10000}];

ints=RandomInteger[{-5,5},30]

lis={{a,b},{c,d},{e,f},{g,h}};

Length[lis]

Dimensions[lis]

MatrixForm[lis]

Position[lis,g]

SeedRandom[1];
lis=RandomChoice[{.0001,.9999}->{0,1},{10000}];

FreeQ[lis,0]

Count[lis,0]

ints=RandomInteger[{-5,5},30]

Count[ints,0]

Count[ints,Except[1]]

Dimensions[{{{1,a},{2,b},{3,c}},{{4,d},{5,e},{6,f}}}]

Position[{{2,1,10},{9,5,7},{2,10,4},{10,1,9},{6,1,6}},9]

ints=Range[4302407360,4302407713];

pos=Position[ints,p_?PrimeQ]

Extract[ints,pos]

PrimeQ[%]

lis=RandomInteger[{1,20},{12}]

nums=RandomInteger[{-100,100},{25}]

mat=RandomInteger[9,{4,4}];
MatrixForm[mat]

AddColumn[mat,{a,b,c,d},3]//MatrixForm

RandomChoice[Range[0,9],5]

randomChoice[{a,b,c,d,e,f,g,h},12]

TextWords["Use StringSplit to split long strings into words."]

NGrams["Use StringSplit to split long strings into words.",3]

Transpose[{{(Subscript[x, 1]),(Subscript[y, 1])},{(Subscript[x, 2]),(Subscript[y, 2])},{(Subscript[x, 3]),(Subscript[y, 3])},{(Subscript[x, 4]),(Subscript[y, 4])},{(Subscript[x, 5]),(Subscript[y, 5])}}]

lis={5,3,3,8,17,3,3,4,20,2,11,13};

Part[lis,2;;-1;;2]

lis[[2;;-1;;2]]

lis[[1;;-1;;2]]

nums=RandomInteger[{-100,100},{25}]

Sort[nums]

Take[Sort[nums],5]

Take[Sort[nums],-5;;-1]

TakeLargest[nums,5]

TakeSmallest[nums,5]

mat=Table[i j,{i,1,4},{j,1,4}]

MatrixForm[mat]

Outer[Times,Range[4],Range[4]]

Table[mat[[i,j]],{i,1,4},{j,1,i}]

Flatten[%]

Total[%]

lis=Range[10]

p=Partition[lis,5]

Riffle[p[[1]],p[[2]]]

Apply[Riffle,p]

PrimePi[100]

Table[Prime[n],{n,PrimePi[100]}]

n=4;
lis=Partition[Range[(n^2)],n]

Grid[lis,Frame->All]

n=4;
lis=Multicolumn[Range[(n^2)],n,Appearance->"Horizontal",Frame->All]

Clear[n]

IntegerDigits[Fibonacci[50]]

First[%]

digits=Table[First[IntegerDigits[Fibonacci[i]]],{i,(10^4)}];

Histogram[digits]

mat=RandomInteger[9,{4,4}];
MatrixForm[mat]

temp=mat[[1]];
mat[[1]]=mat[[2]];
mat[[2]]=temp;
MatrixForm[mat]

mat=RandomInteger[9,{4,4}];
MatrixForm[mat]

{mat[[2]],mat[[1]]}={mat[[1]],mat[[2]]};
MatrixForm[mat]

mat=RandomInteger[9,{4,4}];
MatrixForm[mat]

mat[[{2,1}]]=mat[[{1,2}]];
MatrixForm[mat]

mat=RandomInteger[10,{3,3}];
MatrixForm[mat]

Mean[mat]

centeredMat=Transpose[Transpose[mat]-Mean[mat]]

Mean[centeredMat]

CenteringMatrix[n_]:=IdentityMatrix[n]-ConstantArray[1/n,{n,n}]

CenteringMatrix[3].mat

SymmetricMatrixQ[CenteringMatrix[3]]

CenteringMatrix[3].CenteringMatrix[3]==CenteringMatrix[3]

Standardize[mat,Mean,1&]

mat=RandomInteger[9,{4,4}];
MatrixForm[mat]

Transpose[mat]

Insert[Transpose[mat],{a,b,c,d},3]//MatrixForm

Transpose@Insert[Transpose[mat],{a,b,c,d},3]//MatrixForm

AddColumn[mat_,col_,pos_]/;Length[col]==Length[mat]:=Transpose[Insert[Transpose[mat],col,pos]]

Join[{z},{x,y}]

expr=Join[{1,2,3,4},{a,b,c,d}]

expr[[2;;-1;;2]]

Riffle[{1,2,3,4},{a,b,c,d}]

Transpose[{{1,2,3,4},{a,b,c,d}}]

Flatten[%]

randomChoice[lis_,n_]:=lis[[RandomInteger[{1,Length[lis]},{n}]]]

randomChoice[{a,b,c,d,e,f,g,h},12]

A={a,b,c,d};
B={a,b,e,f};

Complement[A⋃B,A⋂B]

Complement[Union[A,B],Intersection[A,B]]

darwin=ExampleData[{"Text","OriginOfSpecies"}];
words=TextWords[darwin]

par=Partition[words,2,1]

tally=SortBy[Tally[par],Last];
Take[tally,-20]

Take[tally,-40;;-21]

WordCounts[darwin,2]

Take[%,20]

NGrams[text_,n_]:=Partition[TextWords[text],n,1]

sentence="Use StringSplit to split long strings into words.";
NGrams[sentence,3]

stringInsert[str1_,str2_,pos_]:=StringJoin@Join[
Take[Characters[str1],pos-1],
Characters[str2],
Drop[Characters[str1],pos-1]
]

stringInsert["Joy world","to the ",5]

stringDrop[str_,pos_]:=StringJoin[Drop[Characters[str],pos]]

stringDrop["ABCDEF",-2]

FromCharacterCode[Join[
ToCharacterCode["To be, "],ToCharacterCode["or not to be"]
]]

FromCharacterCode[Reverse[ToCharacterCode["never odd or even"]]]

Sum[(k^2),{k,1,10}]

Table[Sum[(k^2),{k,1,n}],{n,1,10}]

Sum[(k^2),{k,1,n}]

Table[(1/6) n (1+n) (1+2 n),{n,1,10}]

Range[10].Range[10]

Table[Range[n].Range[n],{n,1,10}]

Total[((Range[10])^2)]

MakeRef[hamming1950]

Hamming, Richard(RowDefault[" (", 1950, ")"])
Error detecting and error correcting codes
MouseOver

alb1=Association[{
"SongTitle"->"Desvairada",
"AlbumArtist"->"Paulo Bellinati",
"AlbumTitle"->"The Guitar Works of Garoto",
"Year"->"1991",
"Cover"->
}];

alb2=Association[{
"SongTitle"->"Monk's Mood",
"AlbumArtist"->"Bud Powell",
"AlbumTitle"->"Round About Midnight At The Blue Note",
"Year"->"1962",
"Cover"->
}];

alb3=Association[{
"SongTitle"->"Dounia",
"AlbumArtist"->"Rokia Traoré",
"AlbumTitle"->"Tchamantché",
"Year"->"2008",
"Cover"->
}];

Map[Thumbnail,{alb1["Cover"],alb2["Cover"],alb3["Cover"]}]

makeAuthor[ref_]:=Style[ref["Author"],"TR"]

makeTitle[ref_]:=Style[ref["Title"],"TI"]

makeLink[ref_]:=Hyperlink[Style[ref["Url"],"TR"],ref["Url"]]

makeDate[ref_]:=Row[{Style[" (","TR"],Style[ref["Year"],"TB"],Style[")","TR"]}]

MakeRef[ref_]:=CellPrint@TextCell[Row[{
makeAuthor[ref],makeDate[ref],"\n",
makeTitle[ref],"\n",
makeLink[ref]
}],"Text",ShowStringCharacters->False]

art1=Association@{
"Author"->"Hamming, Richard W.",
"Title"->"Error detecting and error correcting codes",
"Journal"->"The Bell System Technical Journal",
"Year"->1950,
"Volume"->29,
"Issue"->2,
"Pages"->"147–160",
"Url"->"https://archive.org/details/bstj29-2-147"
}

MakeRef[art1]

Hamming, Richard W.(RowDefault[" (", 1950, ")"])
Error detecting and error correcting codes
MouseOver

MatchQ[3+4I,a_+b_I]

MatchQ[1/y,a_/b_]

MatchQ[x/y, Power[a_, -1]]

MatchQ[{4,6,8},x_/;Length[x]>4]

MatchQ[{4,6,8},{x___}/;Length[x]>4]

MatchQ[{4,6,8},{x___}/;Plus[x]>10]

Needs["EPM`RandomWalks`"]

walk=RandomWalk[1000,Dimension->1];
showWalk[walk]

walks=Table[RandomWalk[1000,Dimension->1],{25}];
showWalk[walks]

rawData=RandomVariate[NormalDistribution[0,2],{200}];

FullForm[3+4I]

MatchQ[3+4I,_Complex]

MatchQ[3+4I,_?NumberQ]

lis=RandomInteger[1000,{20}]

Cases[lis,n_/;IntegerQ[n/2]||IntegerQ[n/3]||IntegerQ[n/5]]

Cases[lis,n_/;Mod[n,2]==0||Mod[n,3]==0||Mod[n,5]==0]

Select[lis,Mod[#,2]==0||Mod[#,3]==0||Mod[#,5]==0&]

FullForm[{4,{a,b},"g"}]

MatchQ[{4,{a,b},"g"},x_List/;Length[x]==3]

MatchQ[{4,{a,b},"g"},{_,y_,_}/;y[[0]]==List]

MatchQ[{4,{a,b},"g"},{x_,y_,z_}/;AtomQ[z]]

MatchQ[{4,{a,b},"g"},{x_,_,_}/;EvenQ[x]]

FullForm[1/x]

FullForm[a_/b_]

MatchQ[x/y,a_/b_]

Collatz[n_?OddQ]:=3n+1

Collatz[n_?EvenQ]:=(n/2)

NestList[Collatz,23,15]

Collatz[24.0]

Clear[Collatz]

Collatz[n_]:=3n+1/;OddQ[n]&&Positive[n]

Collatz[n_]:=(n/2)/;EvenQ[n]&&Positive[n]

Collatz[4.3]

Collatz[-3]

NestList[Collatz,22,15]

Clear[Collatz]

Collatz[n_/;OddQ[n]&&Positive[n]]:=3n+1

Collatz[n_/;EvenQ[n]&&Positive[n]]:=(n/2)

NestList[Collatz,22,15]

abs[x_Real|x_Integer|x_Rational]:=If[x≥0,x,-x]

abs[x_Complex]:=(Sqrt[((Re[x])^2)+((Im[x])^2)])

Map[abs,{-3,3+4I,((-4)/5),a}]

swapTwo[{}]:={}
swapTwo[{x_}]:={x}

swapTwo[{x_,y_,r___}]:={y,x,r}

swapTwo[{}]

swapTwo[{a}]

swapTwo[{a,b,c,d}]

swapTwo2[{x_,y_,r___}]:={y,x,r}
swapTwo2[x_]:=x

swapTwo[{}]

swapTwo[{a}]

swapTwo[{a,b,c,d}]

showWalk[coords_?VectorQ] := ListLinePlot[coords]

Needs["EPM`RandomWalks`"]

walk=RandomWalk[1000,Dimension->1];
showWalk[walk]

walks=Table[RandomWalk[10,Dimension->1],{25}];
Dimensions[walks]

Short[Take[walks,5],2]

showWalk[coords:{{__?NumberQ}..}]:=ListLinePlot[coords,PlotStyle->Directive[Thin]]

walks=Table[RandomWalk[1000,Dimension->1],{25}];
showWalk[walks]

data=RandomVariate[NormalDistribution[0,2],{200}];

{μ,σ}={Mean[data],StandardDeviation[data]}

filtered=Cases[data,p_/;Abs[μ-p]<σ];
len=Length[filtered]

ListPlot[data,Epilog->{
Dashed,Line[{{0,σ},{len,σ}}],Line[{{0,-σ},{len,-σ}}]}]

{{a,b},{c,d},{e,f}}/.{x_,y_}:>{y,x}

{{a,b},{c,d}}/.{x_,y_}:>{y,x}

mat={{a,b,c},{d,e,f},{g,h,i}};

mat/.{x_,y_,z_}:>{x,z,y}//MatrixForm

unNest[{{α,α,α},{α},{{β,β,β},{β,β}},{α,α}}]

cartesianProduct[{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])},{(Subscript[y, 1]),(Subscript[y, 2])}]

MultiplyCount[(t^5)]

MultiplyCount[a x y t]

MultiplyCount[a x y (t^4)+w t]

Table[Dice[n],{n,1,6}]

Dice[n_]:=GraphicsGrid[
  Map[Graphics,Partition[Range[9],3]/.rules[[n]],{2}]]

ParametricPlot3D[{(2+Cos[v]) Sin[u],(2+Cos[v]) Cos[u],Sin[v]},{u,0,2 π},{v,0,2 π}]

{{a,b},{c,d}}/.{x_Symbol,y_Symbol}:>{y,x}

{{a,b},{c,d},{e,f}}/.{x_Symbol,y_Symbol}:>{y,x}

mat={{a,b,c},{d,e,f},{g,h,i}};
MatrixForm[mat]

mat/.{x_,y_,z_}:>{x,z,y}//MatrixForm

mat/.{x_Symbol,y_Symbol,z_Symbol}:>{x,z,y}//MatrixForm

soln=Solve[(x^9)+3.4 (x^6)-25 (x^5)-213 (x^4)-477 (x^3)+1012 (x^2)+111 x-123==0,x]

Cases[soln,{x_->_?Negative}]

Cases[soln,{_->_Real}]

DeleteCases[soln,{_->_Complex}]

unNest[lis_]:=Map[(#//.{x__}:>x&),lis]

unNest[{{a,a,a},{a},{{b,b,b},{b,b}},{a,a}}]

sumList[lis_]:=First[lis//.{x_,y___}->x+{y}]

sumList[{1,5,8,3,9,3}]

cartesianProduct[lis1_,lis2_]:=ReplaceList[{lis1,lis2},{{___,x_,___},{___,y_,___}}:>{x,y}]

cartesianProduct[{}]:={}

Clear[x,y,z,a,b,c,d]

cartesianProduct[{a,b,c},{x,y,z}]

cartesianProduct[{}]

Cases[{x^4},Power[_,exp_]:>exp-1]

Cases[{a b c d e},fac_Times:>Length[fac]-1]

MultiplyCount[expr_]:=Total@Cases[{expr},Power[_,exp_]:>exp-1,Infinity]+Total@Cases[{expr},fac_Times:>Length[fac]-1,Infinity]

MultiplyCount[a (b^2)c (d^5)]

poly=Expand[(((x+y-z))^3)]

MultiplyCount[poly]

lis=Partition[Range[9],3];
Grid[lis]

off={Red,Disk[]};
on={White,Disk[]};

GraphicsGrid[Map[Graphics,
lis/. {1->on,2->off,3->on,4->off,5->on,6->off,7->on,8->off,9->on},
{2}],Background->Red,Spacings->10,ImageSize->40]

Dice[n_]:=Module[{rules,off={Darker@Blue,Disk[]},on={White,Disk[]}},
rules={
{1->off,2->off,3->off,4->off,5->on,6->off,7->off,8->off,9->off},
{1->off,2->off,3->on,4->off,5->off,6->off,7->on,8->off,9->off},
{1->off,2->off,3->on,4->off,5->on,6->off,7->on,8->off,9->off},
{1->on,2->off,3->on,4->off,5->off,6->off,7->on,8->off,9->on},
{1->on,2->off,3->on,4->off,5->on,6->off,7->on,8->off,9->on},
 {1->on,2->off,3->on,4->on,5->off,6->on,7->on,8->off,9->on}
};
GraphicsGrid[Map[Graphics,
Partition[Range[9],3]/. rules[[n]],
{2}],Background->First[off],Spacings->10,ImageSize->40]
]

Table[Dice[n],{n,1,6}]

Dice[n_,OptionsPattern[]]:=Module[{rules,color,grid},
color=OptionValue[Color];
rules={0->{color,Disk[]},1->{White,Disk[]}};
grid={
{0,0,0,0,1,0,0,0,0},
{0,0,1,0,0,0,1,0,0},
{0,0,1,0,1,0,1,0,0},
{1,0,1,0,0,0,1,0,1},
{1,0,1,0,1,0,1,0,1},
 {1,0,1,1,0,1,1,0,1}
};
GraphicsGrid[Map[Graphics,Partition[grid[[n]],3]/.rules,{2}],Background->color,Spacings->10,ImageSize->40]
]

Array[Dice,{6}]

RollDice[]:=GraphicsRow[RandomChoice[Array[Dice,{6}],{2}]]

RollDice[]

RollDice[n_]:=Table[RollDice[],{n}]

RollDice[4]

torus=ParametricPlot3D[{(2+Cos[v]) Sin[u],(2+Cos[v]) Cos[u],Sin[v]},{u,0,2 π},{v,0,2 π}]

Short[InputForm[torus],5]

points=Cases[torus,GraphicsComplex[pts:{{_,_,_}..},__]:>pts,Infinity]

ListPointPlot3D[points,PlotStyle->PointSize[Small]]

data=(({{0.9034, "NAN", 0.7163, 0.8588}, {0.3031, 0.5827, 0.2699, 0.8063}, {0.0418, 0.8426, "NAN", 0.8634}, {"NAN", 0.8913, 0.0662, 0.8432}}));

data=RandomInteger[{0,9},{5,2}];

MatrixForm[data,TableAlignments->"."]

CountChange[{,,,,}]

pidigs=First[RealDigits[π,10,100]]

FindSubsequence[pidigs,{3,8}]

SeedRandom[6];
n=RandomInteger[(10^200)]

FindSubsequence[n,965]

data=Import["http://wso.stanford.edu/meanfld/MF_timeseries.txt","Table"];
Take[data,10]

DateList[{"1975:05:18_20h",{"Year",":","Month",":","Day","_","Hour","h"}}]

compositeQ[n_Integer/;n>1]:=Not[PrimeQ[n]]

compositeQ[16]

compositeQ[(2^31)-1]

compositeQ[(2^63)-1]===CompositeQ[(2^63)-1]

splot=Plot[Sinc[x],{x,-2 π,2 π}]

Show[splot/. {x_?NumberQ,y_?NumberQ}:>{x,-y},PlotRange->All]

array=(({{0.9034000000000001`, "NAN", 0.7163`, 0.8588`, 0.1228`}, {0.30310000000000004`, 0.5827`, 0.26990000000000003`, 0.8063`, "NAN"}, {0.041800000000000004`, 0.8426`, "NAN", 0.8634000000000001`, 0.9682000000000001`}, {0.9163`, 0.8913000000000001`, 0.06620000000000001`, 0.8432000000000001`, 0.054700000000000006`}, {0.7937000000000001`, 0.6905`, 0.9105000000000001`, 0.5589000000000001`, 0.8993`}}));

col2=array[[All,2]];
Cases[col2,_?NumberQ]

Mean[Cases[col2,_?NumberQ]]

col2/."NAN"->Mean[Cases[col2,_?NumberQ]]//MatrixForm

fixcolumn[col_]:=array[[All,col]]/."NAN":>Mean[Cases[array[[All,col]],_?NumberQ]]

fixcolumn[1]

Map[fixcolumn,Range[Length[First[array]]]]//MatrixForm

MatrixForm[Transpose[%]]

FixArray[mat_]:=Module[{fixcolumn},
fixcolumn[col_]:=mat[[All,col]]/."NAN":>Mean[Cases[mat[[All,col]],_?NumberQ]];
Transpose[Map[fixcolumn,Range[Length[First[mat]]]]]
]

FixArray[array]//MatrixForm

data=RandomReal[{0,1},{8,2}]

data/.{x_,y_}:>{x,y,Mean[{x,y}]}//MatrixForm

plot=Plot[Sin[x],{x,0,2π}]

plot/.{x_?NumericQ,y_?NumericQ}:>{x,y/2}

Show[
plot/.{x_?NumericQ,y_?NumericQ}:>{x,y/2},
PlotRange->{{0,2π},{-1,1}}]

{q,d,n,p}={,,,};

coins={p,p,q,n,d,d,p,q,q,p}

values={p->.01,n->.05,d->.10,q->.25};

coins/.values

Total[coins/.values]

CountChange[coins_List]:=
Total[coins/.{->.01,->.05,->.10,->.25}]

CountChange[{,,,,,,,,,}]

pidigs=First[RealDigits[π,10,50]]

subseq={3,2,3,8};

p=Partition[pidigs,Length[subseq],1]

pos=Position[p,subseq]

pos/.{num_?IntegerQ}:>{num,num+Length[subseq]-1}

FindSubsequence[digits_List,subseq_List]:=
Position[Partition[digits,Length[subseq],1],subseq]/.{num_?IntegerQ}:>{num,num+Length[subseq]-1}

pidigs=First[RealDigits[π,10,(10^7),-1]];

FindSubsequence[pidigs,{3,1,4,1,5,9}]//Timing

FindSubsequence[n_Integer,subseq_Integer]:=
FindSubsequence[IntegerDigits[n],IntegerDigits[subseq]]

pi=FromDigits[First@RealDigits[N[Pi,(10^5)]-3]];

FindSubsequence[pi,1415]

area[Triangle[pts:{_,_,_}]]:=(1/2)√(((Det[pts[[All,{2,3}]]/.{a_,b_}:>{a,b,1}])^2)+((Det[pts[[All,{3,1}]]/.{a_,b_}:>{a,b,1}])^2)+((Det[pts[[All,{1,2}]]/.{a_,b_}:>{a,b,1}])^2))

pts={{0,0,0},{3,4,0},{5,5,5}};

Area[Triangle[pts]]

area[Triangle[pts]]

data=Import["http://data.giss.nasa.gov/gistemp/tabledata_v3/GLB.Ts+dSST.txt",{"Table","Data"}];

data[[9;;-13]];

DeleteCases[data[[9;;-13]],{"Year",__}|{}];

tempData=TimeSeries[%[[All,14]]/100.,{"1880","2014"}]

avg=MovingAverage[tempData,5];

DateListPlot[{tempData,avg},PlotStyle->{LightGray,Gray},Mesh->All,MeshStyle->Directive[PointSize[Small],Gray],GridLines->{ToString/@Range[1880,2010,10],Automatic},ImageSize->Small,Epilog->{Pink,Thick,Line[{{"1880",0},{"2015",0}}]},FrameLabel->{None,"Difference from 1951-1980 average (°C)"},PlotLegends->{"yearly data","5-year moving avg"}]

Clear[x,y,z,f,g,p,q,d,n,a,b,c,d,e]

data=Import["http://wso.stanford.edu/meanfld/MF_timeseries.txt","Table"]

data[[2]]//InputForm

dateConvert[str_String]:=DateList[{str,{"Year",":","Month",":","Day","_","Hour","h"}}]

data2=Rest@data/.{date_String,val_}:>{dateConvert[date],val}

data2[[8]]//InputForm

data3=data2/.{date_List,_String}:>{date,Missing[]}

tsData=TimeSeries[data3]

DateListPlot[tsData,AspectRatio->1/4,PlotStyle->Thin,PlotRange->All]

data=Rest@Import["http://wso.stanford.edu/meanfld/MF_timeseries.txt","Table", "DateStringFormat" -> {"Year",":","Month",":","Day","_","Hour","h"}]

tsData=TimeSeries[data]

DateListPlot[tsData,AspectRatio->1/4,PlotStyle->Thin,PlotRange->All]

MovingAverage[{a,b,c,d,e},2]

Thread[Equal[{x,y,z},{a,b,c}]]

pt1={0,0};pt2={5,2};pt3={3,4};
Graphics[Triangle[{pt1,pt2,pt3}],Axes->Automatic]

Area[Triangle[{pt1,pt2,pt3}]]

StringJoin[{"A","T"}]//InputForm

aa={"A","R","N","D","C","E","Q","G","H","I","L","K","M","F","P","O","U","S","T","W","Y","V"};

{{1,2},{3,4}}.{x,y}

mat=RandomInteger[1,{5,5}];
MatrixForm[mat]

AdjacencyGraph[mat,VertexLabels->"Name"]

lis=RandomInteger[9,{12,2}]

ToEdges[lis]

ToEdges[{3,6}]

FactorInteger[3628800]

PrimeFactorForm[12]

Clear[a,b,c,d,e,f,g,h,i]

Partition[{a,b,c,d,e},2,1]

Map[Mean,%]

MovingAverage[{a,b,c,d,e},2]

Map[Mean,Partition[{a,b,c,d,e},3,1]]

squareMatrixQ[mat_?MatrixQ]:=Dimensions[mat][[1]]==Dimensions[mat][[2]]

squareMatrixQ[mat_?MatrixQ]:=Apply[Equal,Dimensions[mat]]

squareMatrixQ[{{a,b},{c,d},{e,f}}]

squareMatrixQ[{{a,b,c},{d,e,f},{g,h,i}}]

Clear[x,y,z]

Thread[Equal[{x,y,z},{a,b,c}]]

Inner[Equal,{x,y,z},{a,b,c},List]

pt1={0,0};
pt2={5,2};
pt3={3,5};

pairs=Subsets[{pt1,pt2,pt3},{2}]

{a,b,c}=Apply[EuclideanDistance,pairs,{1}]

s=(a+b+c)/2

(Sqrt[s(s-a)(s-b)(s-c)])//Simplify

Area[Triangle[{pt1,pt2,pt3}]]

Clear[a,b,c,s]

SquareNumberQ[n_Integer]:=IntegerQ[(Sqrt[n])]

FromDigits[{1,2,3,4,5,6,7,8,9}]

nums=Map[FromDigits,Permutations[Range[9]]]

Select[nums,SquareNumberQ]

(Sqrt[%])

PerfectQ[n_]:=Total[Divisors[n]]==2n

PerfectSearch[n_]:=Select[Range[n],PerfectQ]

PerfectSearch[(10^6)]//Timing

PerfectQ[n_]:=DivisorSigma[1,n]==2n

PerfectSearch[(10^6)]//Timing

PrimesLessThan[n_]:=Table[Prime[p],{p,PrimePi[n]}]

PrimesLessThan[100]

lis=Outer[StringJoin,{"A","C","T","G"},{"A","C","T","G"}]

Outer[sj,{"A","C","T","G"},{"A","C","T","G"}]

Flatten[lis]

Outer[StringJoin,{"A","C","T","G"},{"A","C","T","G"},{"A","C","T","G"}]//Flatten

Table[{"A","C","T","G"},{4}]

Outer[StringJoin,%]

Apply[Sequence,Table[{"A","C","T","G"},{4}]]

Outer[StringJoin,%]//Flatten

Clear[NGrams]

NGrams[alphabet:{__String},n_Integer?Positive]:=Flatten[Outer[StringJoin,Apply[Sequence,Table[alphabet,{n}]]]]

NGrams[{"A","C","T","G"},3]

alphabet={"K","P","W","G","E","V","Y","L","M","Q","R","S","F","D","H","I","C","T","N","A"};

NGrams[alphabet,2]

LeadingDigit[n_Integer]:=First[IntegerDigits[n]]

LeadingDigit[2495874985797]

LeadingDigit[{434,826,5632}]

SetAttributes[LeadingDigit,Listable]

fibs=Table[Fibonacci[i],{i,10000}];

Histogram[LeadingDigit[fibs]]

data=RandomReal[{-20,20},{40,2}];

ListPlot[data,AspectRatio->Automatic]

Take[data,2]

Transpose[{{(Subscript[x, 1]),(Subscript[y, 1])},{(Subscript[x, 2]),(Subscript[y, 2])},{(Subscript[x, 3]),(Subscript[y, 3])}}]

Map[Min,%]

{xmin,ymin}=Map[Min,Transpose[data]]

{xmax,ymax}=Map[Max,Transpose[data]]

{{xmin,xmax},{ymin,ymax}}=Map[MinMax,Transpose[data]]

ListPlot[data,AspectRatio->Automatic,Epilog->{
Opacity[.25],EdgeForm[Dashed],Rectangle[{xmin,ymin},{xmax,ymax}]}]

data3d=RandomReal[{-10,10},{25,3}];

{{xmin,xmax},{ymin,ymax},{zmin,zmax}}=Map[MinMax,Transpose[data3d]]

Graphics3D[{
Point[data3d],
Blue,Opacity[.25],Cuboid[{xmin,ymin,zmin},{xmax,ymax,zmax}]
},Boxed->False]

pts=RandomReal[1,{100,2}];

pairs=Subsets[pts,{2}];

Apply[EuclideanDistance,pairs,{1}];

Max[%]

PointsetDiameter[pts_List]:=Max[Apply[EuclideanDistance,Subsets[pts,{2}],{1}]]

PointsetDiameter[pts]

MaximalBy[pairs,Apply[EuclideanDistance,#]&]

Apply[EuclideanDistance,%,{1}]

pts3D=RandomReal[1,{5,3}]

PointsetDiameter[pts3D]

Timing[Subsets[Range[1000],{2}];]

Timing[Subsets[Range[2000],{2}];]

n=12;
centers=RandomReal[{-1,1},{n,2}]

radii=RandomReal[1,{n}]

circles=MapThread[Circle,{centers,radii}];

Graphics[circles]

Graphics[circles/.Circle[x__]:>{Thick,RandomColor[],Circle[x]}]

Transpose[{{1,2},{3,4}}] {x,y}

Total[%]

Inner[Times,{{1,2},{3,4}},{x,y},Plus]

mat=RandomInteger[1,{5,5}];
MatrixForm[mat]

Map[Total,mat+Transpose[mat]]

gr=AdjacencyGraph[mat,VertexLabels->"Name"]

VertexDegree[gr]

ToEdges[lis:{{_,_}..}]:=Apply[DirectedEdge,lis,{1}]

lis=RandomInteger[9,{12,2}];
ToEdges[lis]

ToEdges[{3,6}]

ToEdges[lis:{_,_}]:=Apply[DirectedEdge,lis]

ToEdges[{3,6}]

facs=FactorInteger[3628800]

Apply[Power,facs,{1}]

Apply[Times,%]

ExpandFactors[lis_]:=Apply[Times,Apply[Power,lis,{1}]]

FactorInteger[295232799039604140847618609643520000000]

ExpandFactors[%]

facs=FactorInteger[3628800]

{base,exponents}=Transpose[facs]

Inner[Power,base,exponents,Times]

ExpandFactors2[lis_]:=Inner[Power,Sequence@@Transpose[lis],Times]

ExpandFactors2[facs]

lis=FactorInteger[10!]

Apply[Superscript,lis,{1}]

Apply[CenterDot,%]

PrimeFactorForm[p_]:=CenterDot@@(Superscript@@@FactorInteger[p])

PrimeFactorForm[20!]

PrimeFactorForm[9]

PrimeFactorForm[p_?PrimePowerQ]:=First[Superscript@@@FactorInteger[p]]

PrimeFactorForm[9]

?PrimeFactorForm

PrimeFactorForm[p_Integer]:=With[{fp=FactorInteger[p]},
Interpretation[
CenterDot@@(Superscript@@@fp),
Times@@(Power@@@fp)]]

PrimeFactorForm[12!]

VandermondeMatrix[n_,x_]:=
Outer[Power,Table[(Subscript[x, i]),{i,1,n}],Range[0,n-1]]

VandermondeMatrix[4,x]//MatrixForm

Inner[d,{e1,e2,e3},{v1,v2,v3},Plus]

div[vecs_,vars_]:=Inner[D,vecs,vars,Plus]

div[{x,y,z}/((((x^2)+(y^2)+(z^2)))^(3/2)),{x,y,z}]

Simplify[%]

JacobianMatrix[vec_List,vars_List]:=Outer[D,vec,vars]

JacobianMatrix[vec_List,vars_List]:=Outer[D,vec,vars]/;Dimensions[vec]==Dimensions[vars]

x=ρ Cos[θ];
y=ρ Sin[θ];

JacobianMatrix[{x,y},{ρ,θ}]//MatrixForm

Det[%]//Simplify

Integrate[Abs@Det[JacobianMatrix[{x,y},{ρ,θ}]],{ρ,0,r},{θ,0,2 π},Assumptions->r>0]

x=ρ Cos[θ]Sin[ϕ];
y=ρ Sin[θ]Sin[ϕ];
z=ρ Cos[ϕ];

Integrate[Abs@Det@JacobianMatrix[{x,y,z},{ρ,θ,ϕ}],{ρ,0,r},{θ,-π/2,π/2},{ϕ,0,2π}]

primes=Table[Prime[n],{n,1,50}]

Select[Table[(2^p)-1,{p,primes}],PrimeQ]

Select[Table[(2^(Prime[n]))-1,{n,1,50}],PrimeQ]

Clear[a,b,c,d,e,x,y,z,pt1,pt2,pt3]

IntegerDigits[22,2]

Clear[f,z,julia]

f[z_]:=z^2+-0.8-0.156 I
julia[z_]:=FixedPointList[f,z,SameTest->(Abs[#2]>4.0&)]

NestWhileList[julia,-0.5+1.5I,Abs[#]<4.0&]

IntegerDigits[64]

((IntegerDigits[64])^3)

Total[((IntegerDigits[64])^3)]

sumsOfCubes[n_]:=Total[((IntegerDigits[n])^3)]

NestList[sumsOfCubes,4,12]

NestList[sumsOfCubes,32,12]

NestList[sumsOfCubes,123,12]

tri=Triangle[CirclePoints[3]]

Graphics[{Opacity[.35],EdgeForm[Black],tri}]

vecs={{(1/2),0},{(1/4),((Sqrt[3])/4)}};

Translate[tri,{1/2,0}]

translation[gr_]:=Translate[gr,vecs]

tranTri=NestList[translation,tri,1]

Graphics[{Opacity[.35],EdgeForm[{Black,Thin}],
tranTri,{Red,tri}}]

fac[n_]:=Fold[Times,1,Range[n]]

fac[10]

IntegerDigits[25,2]

Clear[f,a,b,x]

f[a_,b_]:=a^2x^b

FoldList[f,x,Rest[{1,1,0,0,1}]]

FoldList[#1^2 x^#2&,x,Rest[{1,1,0,0,1}]]

FoldList[#1^2 x^#2&,1,{1,1,0,0,1}]

exp=4523;
digs=IntegerDigits[exp,2];
FoldList[#1^2 x^#2&,1,digs]

vertices=N[{{0,0},{1,0},{1/2,1}}];

translateVecs=0.5vertices

tri=Polygon[vertices];
Graphics[{
Blue,Translate[Scale[tri,0.5,{0.,0.}],translateVecs]
}]

Graphics[{Blue,Nest[{Blue,Translate[Scale[#,0.5,{0.,0.}],translateVecs]}&,Polygon[vertices],3]}]

SierpinskiTriangle[iter_,opts:OptionsPattern[Graphics]]:=Module[{vertices,vecs},
vertices=N[{{0,0},{1,0},{1/2,1}}];
vecs=0.5vertices;
Graphics[{Blue,Nest[{Blue,Translate[Scale[#,0.5,{0.,0.}],vecs]}&,Polygon[vertices],iter]},opts]]

SierpinskiTriangle[9]

Permutations[{1,2,3}]

powersOf2[0]=1;

powersOf2[n_]:=2 powersOf2[n-1]

Table[powersOf2[j],{j,0,10}]

fact[0]=1;

fact[n_Integer?NonNegative]:=n fact[n-1]

Table[fact[j],{j,1,10}]

fact[3.6]

fact[-4]

hanoi[1]=1;

hanoi[n_]:=2hanoi[n-1]+1

Table[hanoi[i],{i,10}]

Table[(2^n)-1,{n,10}]

Clear[a,b,c]

a[1]:=2
a[2]:=3
a[i_]:=a[i-1] a[i-2]

Table[a[i],{i,1,8}]

b[1]:=0
b[2]:=1
b[i_]:=b[i-2]-b[i-1]

Table[b[i],{i,1,9}]

c[1]:=0
c[2]:=1
c[3]:=2
c[i_]:=c[i-3]+c[i-2]+c[i-1]

Table[c[i],{i,1,9}]

f[n_Integer?NonPositive]:=(((-1))^(n-1))Fibonacci[-n]

f[0]=0;
f[-1]=1;

Table[f[i],{i,0,-8,-1}]

reverse[{x_,y__}]:=Join[reverse[{y}],{x}]

reverse[{x_}]:={x}

reverse[{1,β,3/4,"practice makes perfect"}]

transpose[{{x1_,r1__},{x2_,r2__}}]:=Join[{{x1,x2}},transpose[{{r1},{r2}}]]

transpose[{{x_},{y_}}]:={{x,y}}

transpose[{{(Subscript[x, 1]),(Subscript[x, 2])},{(Subscript[y, 1]),(Subscript[y, 2])}}]

transpose[%]

F[1]:=1
F[2]:=1

F[n_?EvenQ]:=2 F[(n/2)-1] F[(n/2)]+((F[(n/2)])^2)
F[n_?OddQ]:=((F[((n-1)/2)+1])^2)+((F[((n-1)/2)])^2)

Map[F,Range[10]]

Timing[F[(10^4)];]

FF[1]:=1
FF[2]:=1

FF[n_?EvenQ]:=FF[n]=2 FF[(n/2)-1] FF[(n/2)]+((FF[(n/2)])^2)
FF[n_?OddQ]:=FF[n]=((FF[((n-1)/2)+1])^2)+((FF[((n-1)/2)])^2)

Map[FF,Range[10]]

Timing[FF[(10^5)];]

Timing[Fibonacci[(10^5)];]

EulerianNumber[0,k_]=0;
EulerianNumber[n_Integer,0]=1;
EulerianNumber[n_Integer,k_Integer]/;k≥n=0;

EulerianNumber[n_Integer,k_Integer]:=(k+1)EulerianNumber[n-1,k]+(n-k)EulerianNumber[n-1,k-1]

Table[EulerianNumber[n,k],{n,0,7},{k,0,7}]//TableForm

EulerianNumber[25,15]//Timing

Clear[EulerianNumber];

EulerianNumber[0,k_]=0;
EulerianNumber[n_Integer,0]=1;
EulerianNumber[n_Integer,k_Integer]/;k≥n=0;

EulerianNumber[n_Integer,k_Integer]:=Block[{$RecursionLimit=Infinity},
EulerianNumber[n,k]=(k+1)EulerianNumber[n-1,k]+(n-k)EulerianNumber[n-1,k-1]]

EulerianNumber[25,15]//Timing

EulerianNumber[600,65];//Timing

N[EulerianNumber[600,65]]

collatz[n_,0]:=n

collatz[n_,i_]:=(collatz[n,i]=((collatz[n,i-1])/2))/;EvenQ[collatz[n,i-1]]

collatz[n_,i_]:=(collatz[n,i]=3collatz[n,i-1]+1)/;OddQ[collatz[n,i-1]]

collatz[27,5]

Table[collatz[27,i],{i,0,114}]

UpperTriangularMatrix[3]//MatrixForm

UpperTriangularMatrix[3,ζ]//MatrixForm

abs[3+4I]

mat={{0,1},{1,1}};
MatrixPower[mat,9]

Fibonacci[10]

data=Table[{x,Sin[x]},{x,0,2π,0.1}];

art2=Association[{"Author"->"Hathaway, David H.","Title"->"The solar cycle","Journal"->"Living Reviews in Solar Physics","Year"->2010,"Volume"->7,"Issue"->"","Pages"->"","Url"->"http://dx.doi.org/10.12942/lrsp-2010-1"}];

art2["Issue"]

volIss[art2]

CollatzSequence[22]

D[Abs[x+3],x]

transposeDo[mat_]:=Module[{matA,rows=Length[mat],cols=Length[mat[[1]]],j,k},matA=ConstantArray[0,{rows,cols}];
Do[matA[[j,k]]=mat[[k,j]],
{j,1,rows},
{k,1,cols}];
matA]

mat1={{a,b,c},{d,e,f},{g,h,i}};
MatrixForm[mat1]

MatrixForm[transposeDo[mat1]]

transposeTable[mat_?MatrixQ]:=Module[{matA,rows,cols},
{rows,cols}=Dimensions[mat];
matA=ConstantArray[0,{rows,cols}];
Table[matA[[j,k]]=mat[[k,j]],{j,rows},{k,cols}]
]

transposeTable[mat1]//MatrixForm

Tally[{a,c,a,a,c,b,a,a,b,c,a,b}]

UpperTriangularMatrix[{m_,n_}]:=Table[If[i≥j,0,1],{i,m},{j,n}]

UpperTriangularMatrix[{m_,n_},val_:1]:=Table[If[i≥j,0,val],{i,m},{j,n}]

UpperTriangularMatrix[{5,5},α]//MatrixForm

sign[x_/;x<0]:=-1
sign[x_/;x>0]:=1
sign[0]=0;
sign[0.0]=0;

sign[0|0.0]=0;

Map[sign,{-2,0,1}]

signIf[x_]:=If[x<0,-1,If[x==0,0,1]]

Map[signIf,{-2,0,1}]

signWhich[x_]:=Which[x<0,-1,x>0,1,True,0]

Map[signWhich,{-2,0,1}]

Piecewise[{{-1,x<0},{1,x>0},{0,x==0}}]

doublePos[lis_]:=Map[If[#>0,2 #,#]&,lis]

doublePos[{4,0,-3,x}]

Clear[abs];
abs[x_]:=Sqrt[((Re[x])^2)+((Im[x])^2)]/;x∈Complexes;
abs[x_]:=x/;x≥0
abs[x_]:=-x/;x<0

abs[3+4I]

abs[-3]

Clear[abs]
abs[x_]:=If[x≥0,x,-x]
abs[x_/;x∈Complexes]:=Sqrt[((Re[x])^2)+((Im[x])^2)]

abs[3+4I]

abs[-3]

FibMat[n_]:=Module[{tempmat={{0,1},{1,1}}},
Do[tempmat=tempmat.{{0,1},{1,1}},{n-2}];
Part[tempmat,2,2]
]

Timing[FibMat[201]]

Timing[Fibonacci[201]]

lis={5,7,2,13,1};
Ceiling[Length[lis]/2]

Part[Sort[lis],Ceiling[Length[lis]/2]]

lis={65,2,78,5};

len=Length[lis];
Part[Sort[lis],len/2;;len/2+1]

Mean[%]

medianP[lis:{__}]:=Module[{len=Length[lis]},
If[OddQ[len],
Part[Sort[lis],Ceiling[len/2]],
Mean@Part[Sort[lis],len/2;;len/2+1]
]]

dataO=RandomInteger[10000,100001];
dataE=RandomInteger[10000,100000];

medianP[dataO]//Timing

Median[dataO]//Timing

medianP[dataE]//Timing

Median[dataE]//Timing

data=Table[{x,Sin[x]},{x,0,2π,0.1}];

clipped=data/.{a_,b_}:>{a,Piecewise[{{0.5,b>0.5},{-0.5,b<-0.5}},b]};

{
ListPlot[data,PlotLabel->"Original data"],
ListPlot[clipped,PlotLabel->"Clipped data",PlotRange->{-1,1}]
}

WhatAmI[expr_]:=Switch[expr,
_Integer,"I am an integer",
_Rational,"I am rational",
_Real,"I am real",
_Complex,"I am complex",
_?NumericQ,"I am numeric",
_,"I am not a number"]

WhatAmI[π]

WhatAmI["a string"]

getVolume[ref_]:=Style[ref["Volume"],"TR",FontWeight->"Bold"]

getIssue[ref_]:=If[ref["Issue"]=="","",
Style[Row[{"(",ref["Issue"],") "}],"TR"]]

volIss[ref_]:=Row[{getVolume[ref],getIssue[ref]}]

art2=Association[{"Author"->"Hathaway, David H.","Title"->"The solar cycle","Journal"->"Living Reviews in Solar Physics","Year"->2010,"Volume"->7,"Issue"->"","Pages"->"","Url"->"http://dx.doi.org/10.12942/lrsp-2010-1"}];

volIss[art2]

collatz[n_]:=(n/2)/;EvenQ[n]

collatz[n_]:=3n+1/;OddQ[n]

collatz[n_Integer?Positive]:=If[EvenQ[n],n/2,3n+1]

CollatzSequence[n_]:=NestWhileList[collatz,n,#≠1&]

CollatzSequence[17]

data3D=Table[Sin[x y],{x,0,4,0.5},{y,0,4,0.5}];

Manipulate[
ListPlot3D[data3D,InterpolationOrder->order,
PlotLabel->
Switch[order,
"None","Linear",
0,"Voronoi cells",
1,"Baricentric",
2,"Natural neighbor"]],
{{order,"None","Interpolation order"},{"None",0,1,2}},SaveDefinitions->True]

fun[x_]:=(x^2)-r;
Simplify[x-((fun[x])/(fun'[x]))]

nestSqrt[r_,init_]:=Nest[((r+((#)^2))/(2#))&,init,10]

nestSqrt[2,N[2,30]]

f[x_]:=(x^2)-2

a=2;
Table[a=N[a-((f[a])/(f'[a]))],{10}]

findRoot[fun_Symbol,{var_,init_},iter_:10]:=Module[{xi=init},
Table[xi=N[xi-((fun[xi])/(fun'[xi]))],{iter}];
{var->xi}]

findRoot[f,{x,2}]

findRoot[f,{x,2},3]

Clear[fib]

fib[n_]:=Module[{prev=0,this=1,next},
Do[next=prev+this;
prev=this;
this=next,
{n-1}];
this]

Table[fib[i],{i,1,10}]

fib2[n_]:=Module[{f1=0,f2=1},
Do[{f1,f2}={f2,f1+f2},
{n-1}];
f2]

Table[fib2[i],{i,1,10}]

{Timing[fib[100000];],Timing[fib2[100000];]}

findRoot[f_,{var_,a_,b_}]:=Module[{x1=a,x2=b,df},
While[Abs[f[x2]]>(1/(10^10)),
df=((f[x2]-f[x1])/(x2-x1));
{x1,x2}={x2,x2-((f[x2])/df)}];
{var->x2}]

f[x_]:=Abs[x+3]

findRoot[f,{x,-3.1,-1.8}]

gcd[m_,n_]:=Module[{a=m,b=n,tmpa},
While[b>0,
tmpa=a;
a=b;
b=Mod[tmpa,b]];
a]

With[{m=12782,n=5531207},
gcd[m,n]]

gcd[m_Integer,n_Integer]:=Module[{a=m,b=n},
While[b>0,
{a,b}={b,Mod[a,b]}];
a]

With[{m=12782,n=5531207},
gcd[m,n]]

Clear[gcd]

gcd[m_Integer,n_Integer]:=If[m>0,gcd[Mod[n,m],m],gcd[m,n]=n]

With[{m=12782,n=5531207},
gcd[m,n]]

lis=Range[10]

x=RandomChoice[lis]

lis2={};
lis2=Append[lis2,x]

lis=Complement[lis,{x}]

x=RandomChoice[lis]
lis2=Append[lis2,x]
lis=Complement[lis,lis2]

Clear[lis,lis2,x];

lis=Range[10];
lis2={};
Do[
x=RandomChoice[lis];
lis2=Append[lis2,x];
lis=Complement[lis,lis2],
{i,1,Length[lis]}]

lis2

lis=Range[10];
lis2={};
Do[
x=RandomChoice[lis];
lis2=Append[lis2,x];
lis=Complement[lis,lis2],
{i,1,Length[lis]}]

randomPermutation[arg_List]:=Module[{lis=arg,x,lis2={}},
Do[
x=RandomChoice[lis];
lis2=Append[lis2,x];
lis=Complement[lis,lis2],
{i,1,Length[arg]}];
lis2]

randomPermutation[Range[20]]

alphabet = CharacterRange["a","z"]

randomPermutation[alphabet]

RandomSample[CharacterRange["a","z"]]

Clear[x,lis,lis2,alphabet]

Clear[p,i,ip];

p=RandomSample[Range[10]]

ip=Table[0,{i,Length[p]}]

For[i=1,i≤Length[p],i++,ip[[p[[i]]]]=i];
ip

p[[ip]]==ip[[p]]

Ordering[p]

Clear[reverse,a,b,c,d,e]

reverse[vec_]:=Module[{vecA,n=Length[vec]},
vecA=ConstantArray[0,{n}];
Do[vecA[[i]]=vec[[n-i+1]],
{i,1,n}];
vecA]

reverse[{a,b,c,d,e}]

reverseStruc[vec_]:=Module[{vecA,n=Length[vec]},
vecA=ConstantArray[0,{n}];
Table[vecA[[i]]=vec[[n-i+1]],{i,n}]
]

reverseStruc[{a,b,c,d,e}]

rotateRight[vec_,n_]:=Module[{vecA,len=Length[vec]},
vecA=ConstantArray[0,{len}];
Do[vecA[[1+Mod[n+i-1,len]]]=vec[[i]],{i,1,len}];
vecA]

rotateRight[{a,b,c,d,e},2]

rotateRightStruc[vec_,n_]:=Module[{vecA,len=Length[vec]},
vecA=ConstantArray[0,{len}];
Table[vecA[[1+Mod[n+i-1,len]]]=vec[[i]],{i,len}];
vecA
]

rotateRightStruc[{a,b,c,d,e},3]

Total[IntegerDigits[7763]]

digitRoot[n_Integer?Positive]:=If[Mod[n,9]==0,9,Mod[n,9]]

digitRoot[7763]

digitRoot2[n_Integer?Positive]:=Module[{locn=n,lis},
While[
Length[lis=IntegerDigits@locn]>1,
locn=Total[lis]];
locn]

digitRoot2[7763]

Piecewise[{{0,x==0&&y==0},{-1,y==0},{-2,x==0},{1,x>0&&y>0},{2,x<0&&y>0},{3,x<0&&y<0}},4]

quadrantPw[{x_,y_}]:=Piecewise[{{0,x==0&&y==0},{-1,y==0},{-2,x==0},{1,x>0&&y>0},{2,x<0&&y>0},{3,x<0&&y<0}},4]

Map[quadrantPw,{{0,0},{4,0},{0,1.3},{2,4},{-2,4},{-2,-4},{2,-4},{2,0},{3,-4}}]

Clear[tally]

tally[lis_List]:=Module[{ulist=Union[lis],cnts},
cnts=Table[0,{Length[ulist]}];
Do[
Do[If[lis[[i]]==ulist[[j]],++cnts[[j]]],{j,1,Length[ulist]}],
{i,1,Length[lis]}];
Transpose[{ulist,cnts}]
]

lis=RandomChoice[{a,b,c},{20}]

tally[lis]

Tally[lis]===tally[lis]

tally2[lis_]:=Module[{ulist=Union[lis],counter},
counter[_]=0;
Map[counter[#]++&,lis] ;
Map[{#,counter[#]}&,ulist]
]

tally2[lis]

data=RandomInteger[{0,9},{50000}];

Timing[tally[data]]

Timing[tally2[data]]

Timing[Tally[data]]

data=RandomVariate[NormalDistribution[0,1],{2500}];

fromDigits[{1,1,0,1},2]

MultiplyCount[a (x^3)+ b (x^2)+c x+d]

MultiplyCount[d+x (c+x (b+a x))]

Binomial[n+1,2]

HornerPolynomial[{a,b,c,d},x]

Expand[%]

words=DictionaryLookup[];
RandomSample[words,18]

angles=RandomReal[{0,2π},{8}]

Graphics[{Circle[],Point[pts]}]

Graphics[{Circle[],Point[pts],Line[lines]}]

ExponentialMovingAverage[{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])},α]

FunctionsWithOption[StepMonitor]

gr=RandomGraph[{8,12},VertexLabels->"Name"]

gr=GridGraph[{7,7},VertexLabels->"Name"];

HighlightGraph[gr,NeighborhoodGraph[gr,25,2]]

Sound[SoundNote[5,1]]//EmitSound

Sound[SoundNote[5,1,"Vibraphone"]]//EmitSound

gr=GraphData[{"CayleyTree",{5,3}}]

AcyclicGraphQ[gr]

Map[Sin[#]/#&,{0,π/6,π/4,π/3,π/2}]

Sinc[{0,π/6,π/4,π/3,π/2}]

Map[Piecewise[{{1,#==0},{Sin[#]/#,#≠0}}]&,{0,π/6,π/4,π/3,π/2}]

Select[Range[1000],IntegerQ[(Sqrt[#])]&]

pts=RandomReal[1,{4,2}]

Norm[pts[[1]]-pts[[2]]]

EuclideanDistance[pts[[1]],pts[[2]]]

pairs=Subsets[pts,{2}]

Apply[Norm[#1-#2]&,pairs,{1}]

Max[%]

Max@Outer[Norm[#1-#2]&,pts,pts,1]

diameter[lis_]:=Max[Apply[Norm[#1-#2]&,Subsets[lis,{2}],{1}]]

diameter[pts]

pts=RandomReal[1,{1500,2}];
diameter[pts]//Timing

Max[Apply[EuclideanDistance,Subsets[pts,{2}],{1}]]//Timing

nextPrime[n_Integer/;n>1]:=NestWhile[#+1&,n,Not[PrimeQ[#]]&]

nextPrime[(2^123)]==NextPrime[(2^123)]

Timing[nextPrime[(2^2500)];]

Timing[NextPrime[(2^2500)];]

RepUnit[n_]:=Nest[(10 #+1)&,1,n-1]

RepUnit[7]

Map[RepUnit[#]&,Range[12]]

RepUnit[n_]:=FromDigits[ConstantArray[1,{n}]]

RepUnit[11]

vertices={{0,0},{1,0},{1/2,(Sqrt[3])/2}};

tri=Triangle[vertices];
Graphics[{LightBlue,EdgeForm[Gray],tri}]

rotation[gr_]:=Rotate[gr,π/13,RegionCentroid[tri]]

Graphics[{
LightBlue,Opacity[.5],EdgeForm[Gray],
NestList[Rotate[#,π/13,RegionCentroid[tri]]&,tri,10]
}]

data=RandomVariate[NormalDistribution[0,1],{500}];

μ=Mean[data];
σ=StandardDeviation[data];
len=Length[data];
ListPlot[data,
Epilog->{Dashed,Red,
Line[{{0,μ+σ},{len,μ+σ}}],
Line[{{0,μ-σ},{len,μ-σ}}]}
]

filtered=Select[data,(Abs[(#-μ)]<σ&)];

N[((Length[filtered])/(Length[data]))]

ListPlot[filtered,PlotRange->All,
Epilog->{Dashed,Red,
Line[{{0,μ+σ},{len,μ+σ}}],
Line[{{0,μ-σ},{len,μ-σ}}]}
]

convert[digits_List,base_:2]:=Fold[(base #1+#2)&,0,digits]

IntegerDigits[9,2]

convert[%]

FromDigits[{1,0,0,1},2]

convert[{a,b,c,d,e},x]

Expand[%]

SeedRandom[0];
NSEW={{1,0},{-1,0},{0,1},{0,-1}};
NestList[#1+RandomChoice[NSEW]&,{0,0},10]

SeedRandom[0];
Accumulate[RandomChoice[NSEW,10]]

expr=(x^2)==2;
FullForm[expr]

var=x;
expr/.Equal[a_,b_]:>Function[Evaluate@var,a-b]

Clear[findRoot];
findRoot[expr_Equal,{var_,init_},ϵ_:0.0001]:=Module[{result,fun},
fun=expr/.Equal[a_,b_]:>Function[Evaluate@var,a-b];
result=NestWhile[#-((fun[#])/(fun'[#]))&,init,Abs[fun[#]]>ϵ&];
{var->result}]

findRoot[(x^2)==2,{x,1.0}]

findRoot[Cos[x]==0,{x,N[1,20]},(10^(-18))]

findRootList[expr_,{var_,init_},ϵ_:(10^(-15))]:=Module[{fun=Function[Evaluate[var],expr]},
NestWhileList[#-((fun[#])/(fun'[#]))&,N[init],Abs[fun[#]]>ϵ&]]

findRoot[expr_Equal,{var_,init_},ϵ_:0.0001]:=Module[{fun},
fun=expr/.Equal[a_,b_]:>Function[Evaluate@var,a-b];
NestWhileList[#-((fun[#])/(fun'[#]))&,N[init],Abs[fun[#]]>ϵ&]]

findRootList[(x^2)-2,{x,1.0}]

findRootList[Cos[x],{x,1.0}]

Clear[findRootList];
findRootList[expr_,{var_,init_},ϵ_:0.0001]:=Module[{result,fun=Function[Evaluate[var],expr]},
Reap@NestWhile[Sow[#-((fun[#])/(fun'[#]))]&,N[init],Abs[fun[#]]>ϵ&]]

findRootList[Cos[x],{x,.5},(10^(-15))]

HornerPolynomial[list_List,var_]:=Fold[var #1+#2&,0,list]

HornerPolynomial[{a,b,c,d,e},x]

Expand[%]

words=DictionaryLookup[];

DictionaryLookup["q"~~__];
RandomSample[%,20]

Select[DictionaryLookup["q"~~__],StringLength[#]==5&]

angles=RandomReal[{0,2π},6];

pts=Map[{Cos[#],Sin[#]}&,angles]

Graphics[{Circle[],Point[pts]}]

lines=Map[{#,{0,0}}&,pts]

Graphics[{Circle[],Point[pts],Line[lines]}]

pts=Map[AngleVector,angles]

Graphics[{
Circle[],
Point[pts],
Map[Line[{{0,0},#}]&,pts]
}]

FoldList[#1+α(#2-#1)&,(Subscript[x, 1]),{(Subscript[x, 2]),(Subscript[x, 3])}]

expMovingAverage[lis_,α_]:=FoldList[#1+α(#2-#1)&,First[lis],Rest[lis]]

expMovingAverage[{a,b,c},α]

ExponentialMovingAverage[{a,b,c},α]

Simplify[%%==%]

facs=FactorInteger[126]

Map[First,facs]

Max[%]<6

Select[Range[1000],Max[Map[First,FactorInteger[#]]]<6&]

With[{n=(10^6)},
Select[Range[n],Max[Map[First,FactorInteger[#]]]<6&]
];//Timing

HammingNumberList[n_]:=Module[{lim},
lim=If[n<100,Ceiling[Log2[n]],Ceiling[Log2[(n/(2 3 5))] Log2[n]]];Join[{1},Take[Union@@NestList[Union@@Outer[Times,{2,3,5},#]&,{2,3,5},lim],n-1]
]]

HammingNumber[n_]:=Part[HammingNumberList[n],n]

HammingNumberList[20]

HammingNumber[1691]//Timing

HammingNumber[(10^6)]//Timing

Options["Integrate"]

Options[Symbol["Integrate"]]

MemberQ[Options[Integrate],Assumptions]

TreeForm[Options[Integrate]]

MemberQ[Options[Integrate],Assumptions,2]

Options[Round]

FunctionsWithOption[opt_Symbol]:=Module[{names,lis},
names=Complement[Names["System`*"],Names["System`$*"]];
lis=DeleteCases[names,f_/;Options[Symbol[f]]==={}];
Select[lis,MemberQ[Options[Symbol[#]],opt,2]&]]

FunctionsWithOption[Compiled]//Timing

Length[Names["System`*"]]

SeedRandom[16];
gr=RandomGraph[{10,15},VertexLabels->"Name"]

EdgeList[gr]

VertexList[gr]

With[{u=3},
Select[VertexList[gr],(EdgeQ[gr,UndirectedEdge[u,#]]&)]
]

adjacencyList[gr_,u_]:=If[DirectedGraphQ[gr],Select[VertexList[gr],EdgeQ[gr,DirectedEdge[u,#]]&],Select[VertexList[gr],EdgeQ[gr,UndirectedEdge[u,#]]&]
]

AdjacencyStructure[gr_Graph]:=Map[{#,adjacencyList[gr,#]}&,VertexList[gr]]

Map[{#,AdjacencyList[gr,#]}&,VertexList[gr]]

AdjacencyStructure[gr_Graph]:=Map[{#,AdjacencyList[gr,#]}&,VertexList[gr]]

AdjacencyStructure[gr]

gr2=Graph[{1\[DirectedEdge]2,2\[DirectedEdge]1,3\[DirectedEdge]1,3\[DirectedEdge]2,4\[DirectedEdge]1,4\[DirectedEdge]2,4\[DirectedEdge]4},VertexLabels->"Name"]

AdjacencyStructure[gr2]

gr=GridGraph[{7,7},VertexLabels->"Name",VertexStyle->{25->Blue},VertexSize->{25->Medium}]

Complement[VertexList@NeighborhoodGraph[gr,25,3],VertexList@NeighborhoodGraph[gr,25,2]]

HighlightGraph[gr,%]

VertexNeighbors[gr_,v_,dist_]:=VertexList[gr,_?(GraphDistance[gr,v,#]==dist&)]

HighlightGraph[gr,VertexNeighbors[gr,25,3]]

digs=First[RealDigits[N[π,50]]];

Sound[SoundNote[#,0.5]&/@digs]//EmitSound

Sound[SoundNote[#,1/(#+1),"Vibraphone"]&/@digs]//EmitSound

Sound[SoundNote[1+2#,1/(#+1),"Vibraphone"]&/@digs]//EmitSound

gr=GraphData[{"Antelope",{6,6}}]

dirgr=DirectedGraph[gr,"Acyclic"]

AcyclicGraphQ[dirgr]

mat=AdjacencyMatrix[dirgr];

Eigenvalues[mat]

NilpotentMatrixQ[mat_?SquareMatrixQ]:=AllTrue[Eigenvalues[mat],(#==0||#==0.0)&]

NilpotentMatrixQ[mat]

Regular2Graph[5]

ProteinData["KLKB1","BiologicalProcesses"]

n=7;
cg=CompleteGraph[n];
EdgeRules[cg]

p=0.45;
probs=RandomVariate[BernoulliDistribution[p],EdgeCount[cg]]

Sound[Map[SoundNote,Range[0,11]]]//EmitSound

l1={1,0,0,1,1};
l2={0,1,0,1,0};

ll=Transpose[{l1,l2}]

Count[ll,{p_,q_}/;p≠q]

HammingDistance3[lis1_List,lis2_List]:=
Count[Transpose[{lis1,lis2}],{p_,q_}/;p≠q]

HammingDistance3[l1,l2]

HammingDistance2[lis1_,lis2_]:=Total[BitXor[lis1,lis2]]

data1=RandomInteger[1,{(10^6)}];

data2=RandomInteger[1,{(10^6)}];

Timing[HammingDistance2[data1,data2]]

Timing[HammingDistance3[data1,data2]]

HammingDistance4[lis1_,lis2_]:=Total[Mod[lis1+lis2,2]]

sig1=RandomInteger[1,{(10^6)}];

sig2=RandomInteger[1,{(10^6)}];

HammingDistance1[lis1_,lis2_]:=
Count[MapThread[SameQ,{lis1,lis2}],False]

Map[{#,Timing[#[sig1,sig2]]}&,{HammingDistance1,HammingDistance2,HammingDistance3,HammingDistance4}]//Grid

median[lis_List/;OddQ[Length[lis]]]:=Part[Sort[lis],Ceiling[Length[lis]/2]]

median[lis_List/;EvenQ[Length[lis]]]:=Module[{len=Length[lis]/2},
Mean[Part[Sort[lis],len;;len+1]]
]

dataE=RandomInteger[10000,100000];

dataO=RandomInteger[10000,100001];

median[dataE]//Timing

Median[dataE]//Timing

median[dataO]//Timing

Median[dataO]//Timing

Clear[median]

median[lis:{__}/;OddQ[Length[lis]]]:=Part[Sort[lis],Ceiling[Length[lis]/2]]

median[lis:{__}/;EvenQ[Length[lis]]]:=Module[{len=Length[lis]/2},
Mean[Part[Sort[lis],len;;len+1]]]

survivor[n_,m_]:=NestList[Rest[RotateLeft[#,m-1]]&,Range[n],n-1]

survivor[11,3]

coins={p,p,q,n,d,d,p,q,q,p};

Map[Count[coins,#]&,{p,n,d,q}]

%.{.01,.05,.10,.25}

CountChange[lis_]:=
Dot[Map[Count[lis,#]&,{p,n,d,q}],{.01,.05,.10,.25}]

CountChange[coins]

CountChange2[lis_]:=
Inner[Times,Map[Count[lis,#]&,{p,n,d,q}],{.01,.05,.10,.25},Plus]

CountChange2[coins]

Tally[coins]/.{d->.10,n->.05,p->.01,q->.25}

Total[Apply[Times,%,{1}]]

CountChange3[lis_]:=Module[{freq},
freq=Tally[lis]/.{p->.01,n->.05,d->.10,q->.25};
Total[Apply[Times,freq,{1}]]]

CountChange3[coins]

Partition[Range[5],2,1,1]

Apply[UndirectedEdge,Partition[Range[5],2,1,1],{1}]

Regular2Graph[n_]:=Graph[UndirectedEdge@@@Partition[Range[n],2,1,1]]

Table[Regular2Graph[n],{n,3,6,1}]

mat3={{0.796495,"N/A",0.070125,"nan",0.806554},
{"nn",-0.100365,0.992736,-0.320560,-0.0805351},
{0.473571,0.460741,0.030060,-0.412400,0.788522},{0.614974,-0.503201,0.615744,0.966053,-0.011776},{-0.828415,0.035514,0.8911617,"N/A",-0.453926}};
MatrixForm[col4=mat3[[All,4]]]

col4/."N/A"|"nan"->Mean[Cases[mat3[[All,4]],_?NumberQ]]//MatrixForm

Apply[Alternatives,{"N/A","nan","nn"}]

colMean[col_,{strings___String}]:=col/.Apply[Alternatives,{strings}]->Mean[Cases[col,_?NumberQ]]

ReplaceElement[mat_,{strings__}]:=
Transpose[Map[colMean[#,{strings}]&,Transpose[mat]]]

ReplaceElement[mat3,{"N/A","nan","nn"}]//MatrixForm

gr=RandomGraph[{5,8}]

With[{n=VertexCount[gr]},
Array[UndirectedEdge,{n,n}]]

If[EdgeQ[gr,#],1/VertexDegree[gr,First@#],0]&;

With[{n=VertexCount[gr]},
Map[EdgeQ[gr,#]&,Array[UndirectedEdge,{n,n}],{2}]]

With[{n=VertexCount[gr]},
Map[If[EdgeQ[gr,#],1/VertexDegree[gr,First@#],0]&,Array[UndirectedEdge,{n,n}],{2}]]

TransitionMatrix[gr_Graph]:=With[{n=VertexCount[gr]},
Map[If[EdgeQ[gr,#],1/VertexDegree[gr,First@#],0]&,Array[UndirectedEdge,{n,n}],{2}]
]

𝒯=TransitionMatrix[gr]

Π=ConstantArray[1/VertexCount[gr],{VertexCount[gr]}]

𝒫=DiscreteMarkovProcess[Π,𝒯];

data=RandomFunction[𝒫,{0,10}]

data["Values"]

walk=UndirectedEdge@@@Partition[data["Values"],2,1]

HighlightGraph[gr,Graph[walk]]

n=7;
cg=CompleteGraph[n]

EdgeRules[cg]

p=0.45;
probs=RandomVariate[BernoulliDistribution[p],EdgeCount[cg]]

includedEdges=Pick[EdgeRules[cg],probs,1]

Graph[includedEdges,DirectedEdges->False]

n=50;p=.12;
cg=CompleteGraph[n];probs=RandomVariate[BernoulliDistribution[p],EdgeCount[cg]];
gr=Graph[Pick[EdgeRules[cg],probs,1],DirectedEdges->False]

{VertexCount[gr],N@GraphDensity[gr]}

RandomGraph[BernoulliGraphDistribution[50,0.12]]

n=7;
lis=Partition[Range[(n^2)],n];
Grid[lis,Frame->All]

Position[lis,p_/;PrimeQ[p]]

Position[lis,p_?PrimeQ]

Map[(#->Pink)&,Position[lis,p_?PrimeQ]]

n=7;
lis=Partition[Range[(n^2)],n];
Grid[lis,
Frame->All,Background->Join[{None,None},{Map[(#->Pink)&,Position[lis,p_?PrimeQ]]}
]]

Clear[n,lis]

Clear[A,B]

expr=(A||B)\[Implies]C;

vars={A,B,C};

tuples=Tuples[{True,False},Length[vars]]

rules=Map[Thread[vars->#]&,tuples]

expr/.rules

table=Transpose@Join[Transpose[tuples],{expr/.rules}]

head=Append[vars,TraditionalForm[expr]]

Prepend[table,head]

Grid[Prepend[table,head]]

Grid[Prepend[table/.{True->"T",False->"F"},head]]

Grid[Prepend[table/.{True->"T",False->"F"},head],
Frame->True,Dividers->{{-2->LightGray},{2->LightGray}},ItemStyle->"Menu"]

cmajor=Table[SoundNote[i],{i,0,11}]

Sound[RandomChoice[cmajor,10]]

notes=Join[{None},Range[0,11]]

durations=Range[1/8,1,1/8]

MapThread[SoundNote[#1,#2]&,
{RandomChoice[notes,8],RandomChoice[durations,8]}]

Sound[%]

RandomNotes[n_Integer,instrument_:"Piano"]:=With[{notes=Join[{None},Range[0,11]],durations=Range[(1/8),1,(1/8)]},Sound[{instrument,MapThread[SoundNote[#1,#2]&,{RandomChoice[notes,n],RandomChoice[durations,n]}]}]]

RandomNotes[20,"Vibraphone"]

Options[BrownianSoundList]={Weights->Automatic};

BrownianSoundList[steps_Integer,instr_:"Vibraphone",OptionsPattern[]]:=Module[{walk,durs,weights},
weights=If[OptionValue[Weights]===Automatic,Table[1/9,{9}],OptionValue[Weights]];
walk[n_]:=Accumulate[RandomChoice[weights->Range[-4,4],n]];
durs=RandomChoice[Range[1/16,1,1/16],{steps}];
Sound@MapThread[SoundNote[#1,#2,instr]&,{walk[steps],durs}]
]

BrownianSoundList[18,"Vibraphone"]//EmitSound

BrownianSoundList[18,"Marimba",Weights->Abs@RandomVariate[NormalDistribution[0,4],9]]//EmitSound

data=RandomReal[{-1,1},{100,2}];

clusters=FindClusters[data,8];
ListPlot[clusters,PlotStyle->PointSize@Medium]

centroids=Map[Mean,clusters]

colors=Take[ColorData[1,"ColorList"],Length[clusters]]

distances=Table[
Max@Map[EuclideanDistance[centroids[[i]],#]&,clusters[[i]]],{i,1,Length[clusters]}]

disks=MapThread[{#1,Disk[#2,#3]}&,{colors,centroids,distances}];

ListPlot[clusters,PlotStyle->colors,AspectRatio->Automatic,Epilog->{
PointSize[Medium],Point[centroids],
Opacity[0.25],EdgeForm[Gray],disks},PlotRangePadding->.35]

SeedRandom[6];
pts=RandomInteger[40,{10,2}]

base=RandomChoice[pts]

path={base}

pts=Complement[pts,path]

base=First@Nearest[pts,path]

path=Join[path,base]

SeedRandom[6];
pts=RandomInteger[40,{10,2}];

base=RandomChoice[pts];
path={base};
Do[
pts=Complement[pts,path];
base=First@Nearest[pts,path];
path=Join[path,base],

{Length[pts]-1}];
path

ArcLength[Line[path/.{a_,b__}:>{a,b,a}]]//N

SeedRandom[6];
pts=RandomInteger[40,{10,2}];
FindShortestTour[pts]

N[%[[1]]]

pts=RandomReal[{-1,1},{1000,2}];

𝒟=Disk[{0,0},1];
𝒫=Polygon[{{-1,-1},{1,-1},{1,1},{-1,1},{-1,-1}}];

Length@Select[pts,RegionMember[𝒟,#]&]

Count[pts,p_/;RegionMember[𝒟,p]]

Length@Select[pts,RegionMember[𝒟,#]&]/Length[pts]

4N[%]

convertToDate[20160702]

mat=HilbertMatrix[3]

sv=SingularValueList[mat]

N[Max[sv]/Min[sv]]

N[First[sv]/Last[sv]]

ConditionNumber[mat_?SquareMatrixQ]:=Module[{sv=SingularValueList[mat]},
First[sv]/Last[sv]]

Table[ConditionNumber[HilbertMatrix[i]],{i,1,5}]//N

mat={{-5046135670319638,-3871391041510136,-5206336348183639,-6745986988231149},{-640032173419322,8694411469684959,-564323984386760,-2807912511823001},{-16935782447203334,-18752427538303772,-8188807358110413,-14820968618548534},{-1069537498856711,-14079150289610606,7074216604373039,7257960283978710}};

ConditionNumber[mat]//N

With[{n=25,p=.2},
cg=CompleteGraph[n];probs=RandomVariate[BernoulliDistribution[p],EdgeCount[cg]];
Graph[Pick[EdgeRules[cg],probs,1],DirectedEdges->False]]

RandomGraphGnp[n_,p_]:=Module[{cg=CompleteGraph[n],probs},
probs=RandomVariate[BernoulliDistribution[p],EdgeCount[cg]];
Graph[Pick[EdgeRules[cg],probs,1],DirectedEdges->False]]

RandomGraphGnp[50,.15]

pts={{0,0},{1,0},{1/2,(Sqrt[3])/2}};

tri=Triangle[pts]

Apply[EuclideanDistance,Subsets[pts,{2}],{1}]

Apply[Equal,%]

EquilateralTriangleQ[Triangle[pts:{__}]]:=Module[{dists},
dists=Apply[EuclideanDistance,Subsets[pts,{2}],{1}];
Apply[Equal,dists]]

𝒯=MeshRegion[pts,Triangle[{1,2,3}]]

MeshPrimitives[𝒯,1]

Map[ArcLength,%]

EquilateralTriangleQ[Triangle[pts:{__}]]:=Module[{dists},
dists=Map[ArcLength,MeshPrimitives[MeshRegion[pts,Triangle[{1,2,3}]],1]];
Apply[Equal,dists]]

tri=Triangle[{{-1,0},{1,0},{2,1}}];
Graphics[tri]

EquilateralTriangleQ[tri]

pts={{0,0},{1,0},{1/2,(Sqrt[3])/2}};
EquilateralTriangleQ[Triangle[pts]]

switchRows[mat_,{r1_,r2_}]:=Module[{lmat=mat},
lmat[[{r1,r2}]]=lmat[[{r2,r1}]];
lmat]

switchColumns[mat_,{c1_,c2_}]:=Transpose@switchRows[Transpose[mat],{c1,c2}]

mat={{a,b,c},{d,e,f},{g,h,i}};
switchColumns[mat,{2,3}]//MatrixForm

FindSubsequence[digits_List,subseq_List]:=Module[{len=Length[subseq]},
Position[Partition[digits,len,1],subseq]/.{num_?IntegerQ}:>{num,num+len-1}
]

pidigs=First[RealDigits[π,10,(10^7),-1]];

FindSubsequence[pidigs,{3,1,4,1,5,9}]//Timing

PerfectSearch[n_,m_]:=Module[{perfectQ},
perfectQ[j_]:=DivisorSigma[1,j]==2 j;Select[Range[n,m,2],perfectQ]]

PerfectSearch[2,(10^7)]//Timing

PerfectSearch[1,10000]

Clear[PerfectSearch]

PerfectSearch[n_?EvenQ,m_]:=Module[{perfectQ},
perfectQ[j_]:=Total[Divisors[j]]==2 j;Select[Range[n,m,2],perfectQ]]

PerfectSearch[2,10000]

PerfectSearch[1,1000]

Clear[PerfectSearch];
PerfectSearch[n_,m_,k_]:=Module[{perfectQ},
perfectQ[j_]:=Total[Divisors[j]]==k j;
Select[Range[n,m],perfectQ]]

PerfectSearch[1,2200000,4]//AbsoluteTiming

DateList["20151015"]

DateList[20151015]

DateList[ToString[20151015]]

Take[%,3]

convertToDate[n_Integer]:=Take[DateList[ToString[n]],3]

convertToDate[20151015]

convertToDate2[n_Integer/;Length[IntegerDigits[n]]==8]:=Module[{str=ToString[n]},
{StringTake[str,4],StringTake[str,{5,6}],StringTake[str,-2]}]

convertToDate2[20151015]

convertToDate3[num_]:=With[{d=IntegerDigits[num]},
{FromDigits[Take[d,4]],
FromDigits[Take[d,{5,6}]],
FromDigits[Take[d,{7,8}]]}]

convertToDate3[20151015]

mat=RandomReal[1,{5,5}];
MatrixForm[mat]

zeroColumns[mat_,n_Integer]:=Module[{lmat=mat},
lmat[[All,n]]=0;
lmat]

zeroColumns[mat_,Span[m_,n_]]:=Module[{lmat=mat},
lmat[[All,m;;n]]=0;
lmat]

zeroColumns[mat_,lis:{__}]:=Module[{lmat=mat},
lmat[[All,lis]]=0;
lmat]

zeroColumns[mat,3]//MatrixForm

zeroColumns[mat,1;;2]//MatrixForm

zeroColumns[mat,{1,3,5}]//MatrixForm

walk2D[t_]:=Module[{dirs,steps},
dirs={{0,1},{0,-1},{1,0},{-1,0}};
steps=RandomChoice[dirs,{t}];
Accumulate[steps]
]

ListLinePlot[walk2D[250],AspectRatio->1]

ListLinePlot[walk2D[25000],AspectRatio->1,PlotStyle->Thin]

dirs3={{1,0,0},{0,1,0},{0,0,1},{-1,0,0},{0,-1,0},{0,0,-1}};

walk3D[t_]:=Accumulate[RandomChoice[dirs3,t]]

Graphics3D[Line[walk3D[2500]]]

mat=RandomInteger[{0,9},{4,4}];
MatrixForm[mat]

switchRows[mat,{5,2}]

switchRows[mat,{0,2}]

Options[RandomGraphGnp]=Options[Graph];

RandomGraphGnp[n_,p_,opts:OptionsPattern[]]:=Module[{cg,probs},
cg=CompleteGraph[n];probs=RandomVariate[BernoulliDistribution[p],EdgeCount[cg]];
Graph[Pick[EdgeRules[cg],probs,1],opts,DirectedEdges->False]]

RandomGraphGnp[n_,p_,opts:OptionsPattern[]]:=Module[{cg,probs},
cg=CompleteGraph[n];probs=RandomChoice[{p,1-p}->{True,False},EdgeCount[cg]];
Graph[Pick[EdgeRules[cg],probs],opts,DirectedEdges->False]]

RandomGraphGnp[30,.2,VertexSize->Large,VertexStyle->Red,EdgeStyle->Thin]

switchRows::badargs="The absolute value of the row indices `1` and `2` in switchRows[mat,`1`,`2`] must be between 1 and `3`, the size of the matrix.";

switchRows[mat_,{r1_Integer,r2_Integer}]:=Module[{lmat=mat,len=Length[mat]},
If[Abs[r1]>len||Abs[r2]>len||r1 r2==0,
Message[switchRows::badargs,r1,r2,len],
lmat[[{r1,r2}]]=lmat[[{r2,r1}]]];
lmat]

mat=RandomInteger[9,{4,4}];
MatrixForm[mat]

switchRows[mat,{0,4}]

switchRows[mat,{2,8}]

MatchQ[{1,2,a},{__?NumericQ}]

StemPlot::badarg="The first argument to StemPlot must be a list of numbers.";

Options[StemPlot]=Options[ListPlot];

StemPlot[lis_,opts:OptionsPattern[]]:=
If[MatchQ[lis,{__?NumericQ}],
ListPlot[lis,opts,Filling->Axis],
Message[StemPlot::badarg]
]

StemPlot[4]

StemPlot[{1,2,c}]

StemPlot[{1,2,3,4,5}]

Options[ToEdges]={DirectedEdges->True};

ToEdges[lis:{{_,_}..},OptionsPattern[]]:=If[OptionValue[DirectedEdges],DirectedEdge@@@lis,UndirectedEdge@@@lis]

ToEdges[lis:{_,_},OptionsPattern[]]:=If[OptionValue[DirectedEdges],DirectedEdge@@lis,UndirectedEdge@@lis]

pairs=Partition[Range[5],2,1]

ToEdges[pairs]

ToEdges[pairs,DirectedEdges->False]

MultiplyCount[expr_,var_]:=If[PolynomialQ[expr,var],Total@Cases[{expr},Power[_,exp_]:>exp-1,Infinity]+Total@Cases[{expr},fac_Times:>Length[fac]-1,Infinity],Message[MultiplyCount::poly,expr]]

PolynomialRemainder[{3x},x+a,x]

MultiplyCount[{a (x^4)+b x+1},x]

MultiplyCount[a (x^4)+b x+1,x]

Tuples[{True,False},2]

chars=CharacterRange["a","z"]

NearTo[chars,"q",{3}]

NearTo[chars,"q",4]

With[{m=8,n=13,prob=0.47},
gg=GridGraph[{m,n}];
probs=RandomVariate[BernoulliDistribution[prob],EdgeCount[gg]];perc=Graph[Pick[EdgeList[gg],probs,1]];
HighlightGraph[gg,perc]]

Amino={{"P",},{"W",},{"L",},{"V",},{"I",},{"N",},{"Q",},{"S",},{"T",},{"C",},{"M",},{"H",},{"A",},{"G",},{"F",},{"Y",},{"K",},{"R",},{"D",},{"E",}};

muc6=StringTake[ProteinData["MUC6","Sequence"],75]

ColorResidues[muc6,ColorScheme->Amino,FrameMargins->2]

RandomWalk::rwn="Argument `1` is not a positive integer.";

RandomWalk::baddim="The value `1` of the option Dimension is not a positive integer.";

latticeWalk[steps_,dim_]:=Module[{w,mat},
mat=Join[IdentityMatrix[dim],-IdentityMatrix[dim]];w=Accumulate[RandomChoice[mat,steps]];
If[dim==1,Flatten[w],w]
]

PositiveIntegerQ[n_]:=IntegerQ[n]&&Positive[n]

Options[RandomWalk]={Dimension->2};

RandomWalk[t_,OptionsPattern[]]:=Module[{dim,latticeQ},
dim=OptionValue[Dimension];
Which[
!PositiveIntegerQ[t],Message[RandomWalk::rwn,t],
!PositiveIntegerQ[dim],Message[RandomWalk::baddim,dim],
True,latticeWalk[t,dim]
]
]

RandomWalk[3]

RandomWalk[4,Dimension->5]

RandomWalk[4,Dimension->-5]

RandomWalk[4.3,Dimension->-5]

ints=Range[1,100,2]

p=ints[[2]];
ints=Drop[ints,p;;-1;;p]

p=ints[[3]];
ints=Drop[ints,p;;-1;;p]

ints=Range[1,1000,2];
Do[
p=ints[[i]];
ints=Drop[ints,p;;-1;;p],
{i,2,32}]
ints

LuckyNumbers[n_Integer?Positive]:=Module[{p,i=2,ints=Range[1,n,2]},
While[ints[[i]]<Length[ints],
p=ints[[i]];
ints=Drop[ints,p;;-1;;p];
i++];
ints]

LuckyNumbers[1000]

Length[LuckyNumbers[(10^6)]]//Timing

Clear[A,B]

expr=(A||B)\[Implies]C;

vars={A,B,C};

tuples=Tuples[{True,False},Length[vars]]

rules=Map[Thread[vars->#]&,tuples]

expr/.rules

table=Transpose@Join[Transpose[tuples],{expr/.rules}]

head=Append[vars,TraditionalForm[expr]]

Prepend[table,head]

Grid[Prepend[table,head]]

Grid[Prepend[table/.{True->"T",False->"F"},head]]

Grid[Prepend[table/.{True->"T",False->"F"},head],
Frame->True,Dividers->{{-2->LightGray},{2->LightGray}},ItemStyle->"Menu"]

TruthTable[expr_,vars_]:=Module[{len=Length[vars],tuples,rules,table,head},
tuples=Tuples[{True,False},len];
rules= Thread[vars->#1]&/@tuples;table=Transpose@Join[Transpose[tuples],{expr/.rules}];head=Append[vars,TraditionalForm[expr]];Grid[Prepend[table/.{True->"T",False->"F"},head],
Frame->True,FrameStyle->Thin,Dividers->{{-2->LightGray},{2->LightGray}},
BaseStyle->"Menu"]]

TruthTable[A∧B\[Implies]¬C,{A,B,C}]

TruthTable[expr_,vars_]:=Module[{table,head},
table=BooleanTable[Flatten[{vars,expr}]];head=Append[vars,TraditionalForm[expr]];Grid[Prepend[table/.{True->"T",False->"F"},head],
Frame->True,FrameStyle->Thin,Dividers->{{-2->LightGray},{2->LightGray}},
BaseStyle->"Menu"]]

TruthTable[A∧B\[Implies]¬C,{A,B,C}]

NearTo[lis_List,elem_,{n_}]:=Module[{pos=Position[lis,elem]},Extract[lis,{pos-n,pos+n}]]

NearTo[lis_List,elem_,n_]:=Module[{pos=Position[lis,elem]},Extract[lis,Range[pos-n,pos+n]]]

chars=CharacterRange["a","z"];

NearTo[chars,"q",{3}]

NearTo[chars,"q",4]

NearToN[lis_,elem_,n_]:=Nearest[lis,elem,{2 n+1,n},DistanceFunction->Function[{x,y},Abs[(Position[lis,y]-Position[lis,x])[[1,1]]]]]

NearToN[chars,"q",4]

SmithNumberQ[n_/;n≤1]:=False

SmithNumberQ[n_?PrimeQ]:=False

lis=FactorInteger[852]

Transpose[lis]

MapThread[IntegerDigits[#1]#2&,%]

Total[Flatten[%]]

Total[IntegerDigits[852]]

SmithNumberQ[n_]:=With[{lis=FactorInteger[n]},
Total[Flatten[MapThread[IntegerDigits[#1]#2&,Transpose[lis]]]]==Total[IntegerDigits[n]]]

Select[Range[100],SmithNumberQ]

Select[Range[(10^4)],SmithNumberQ]//Length

RepUnit[n_]:=Nest[(10 #+1)&,1,n-1]

PrimeQ[RepUnit[19]]

SmithNumberQ[1540RepUnit[23]]

walk1DOffLattice[t_]:=Accumulate[RandomReal[{-1,1},t]]

walk2DOffLattice[t_]:=
Accumulate[Map[{Cos[#],Sin[#]}&,RandomReal[{0,2 π},t]]]

walk2D=walk2DOffLattice[4]

Partition[walk2D,2,1]

Apply[EuclideanDistance,%,1]

walk3DOffLattice[t_]:=Accumulate[Table[Function[{θ,u},{Cos[θ] (Sqrt[1-(u^2)]),Sin[θ] (Sqrt[1-(u^2)]),u}]@@{RandomReal[{0,2 π}],RandomReal[{-1,1}]},{t}]
]

walk3D=walk3DOffLattice[5]

Apply[EuclideanDistance,Partition[walk3D,2,1],1]

offLatticeWalk[t_,dim_]:=Module[{f1,f2,f3},
f1:=RandomReal[{-1,1},t];
f2:=Map[{Cos[#],Sin[#]}&,RandomReal[{0,2 π},t]];
f3:=Table[Function[{θ,u},{Cos[θ] (Sqrt[1-(u^2)]),Sin[θ] (Sqrt[1-(u^2)]),u}]@@{RandomReal[{0,2 π}],RandomReal[{-1,1}]},{t}];
Which[
dim==1,Accumulate[f1],
dim==2,Accumulate[f2],
dim==3,Accumulate[f3]
]
]

ListLinePlot[offLatticeWalk[5000,1]]

ListLinePlot[offLatticeWalk[5000,2],AspectRatio->Automatic,PlotStyle->Thin]

Graphics3D[Line@offLatticeWalk[5000,3]]

Clear[BondPercolation];

Options[BondPercolation]=Options[GridGraph];

BondPercolation[{m_,n_,prob_},opts:OptionsPattern[]]:=Module[{gg,gr},
gg=GridGraph[{m,n},opts];
gr=Graph[Pick[EdgeList[gg],RandomVariate[BernoulliDistribution[prob],EdgeCount[gg]],1]];HighlightGraph[gg,gr,GraphHighlightStyle->"DehighlightFade"]]

BondPercolation[{13,21,.2},VertexSize->.5]

PositiveIntegerQ[n_]:=IntegerQ[n]&&Positive[n]

BondPercolation::badargs="The parameters `1` and `2` must be positive integers.";

Clear[BondPercolation];
BondPercolation[{m_,n_,prob_},opts:OptionsPattern[]]:=Module[{gg,gr},
If[AllTrue[{m,n},PositiveIntegerQ], 
gg=GridGraph[{m,n},opts];
gr=Graph[Pick[EdgeList[gg],RandomVariate[BernoulliDistribution[prob],EdgeCount[gg]],1]];HighlightGraph[gg,gr,GraphHighlightStyle->"DehighlightFade"],

Message[BondPercolation::badargs,m,n]
]]

BondPercolation[{13,17,.2}]

BondPercolation[{-13,17,.2}]

RGBColor[{220/255, 150/255, 130/255}]

Amino={{"P",},{"W",},{"L",},{"V",},{"I",},{"N",},{"Q",},{"S",},{"T",},{"C",},{"M",},{"H",},{"A",},{"G",},{"F",},{"Y",},{"K",},{"R",},{"D",},{"E",}};

Options[ColorResidues]=Join[{ColorScheme->Amino},Options[Framed]];

ColorResidues::usage="ColorResidues[seq] displays a sequence of amino acids from the protein sequence seq.";

makeAAbox[scheme_,opts:OptionsPattern[]]:=Module[{aa,col},
{aa,col}=Transpose[scheme];MapThread[#1:>Framed[#1,opts,Background->#2,FrameStyle->#2]&,{aa,col}]]

makeAAbox[Amino]

ColorResidues[str_String,opts:OptionsPattern[]]:=Module[{cs=OptionValue[ColorScheme]},
Row[Characters[str]/.makeAAbox[cs,FilterRules[{opts},Options[Framed]]]]]

Map[{#,ProteinData["MUC6",#]}&,{"BiologicalProcesses","Memberships","MolecularFunctions"}]//TableForm

muc6=StringTake[ProteinData["MUC6","Sequence"],100];

ColorResidues[muc6,ColorScheme->Amino,FrameMargins->1]

str="this is a test string"

StringTake[str,1]

ToCharacterCode[%]

%-32

FromCharacterCode[%]

StringDrop[str,1]

StringJoin[%%,%]

ToUpperCase[StringTake[str,1]]

StringTake[str,2;;-1]

ToUpperCase[StringTake[str,1]]<>StringTake[str,2;;-1]

Capitalize[str]

ToCharacterCode["10495"]

%-48

Table[(10^j),{j,4,0,-1}]

%.%%

FoldList[#2+10 #1&,0,ToCharacterCode["10495"]-48]

ToExpression["10495"]

str="Mississippi";
Characters[str]

Union[Characters[str]]

DeleteDuplicates[Characters[str]]

UniqueCharacters[str_String]:=DeleteDuplicates[Characters[str]]

protein=ProteinData["PP2672"]

UniqueCharacters[protein]

UniqueCharacters[""]

data=Import["http://www2.census.gov/topics/genealogy/1990surnames/dist.female.first",{"Table"}];

names=data[[All,1]];
RandomChoice[names,12]

firstLetters={"A","D","G","J","M","P","T","W"};

nChars=Characters["PAT"]

SubsetQ[firstLetters,nChars]

PhoneNameQ[name_String]:=Module[{nChars,firstLetters={"A","D","G","J","M","P","T","W"}},
nChars=Characters[name];
SubsetQ[firstLetters,nChars]
]

PhoneNameQ["PAT"]

Length[names]

lis=Select[names,PhoneNameQ]

text=IntegerDigits[ToCharacterCode["Orange"],2,8]

key=First@IntegerDigits[ToCharacterCode["K"],2,8]

lis=Map[BitXor[#,key]&,text]

Map[FromDigits[#,2]&,lis]

ciphertext=FromCharacterCode[%]

XorEncode[text_String,key_String]:=Module[{lis,bitText,bitKey},
bitText=IntegerDigits[ToCharacterCode[text],2,8];bitKey=First@IntegerDigits[ToCharacterCode[key],2,8];
lis=Map[BitXor[#,bitKey]&,bitText];
FromCharacterCode[Map[FromDigits[#,2]&,lis]]
]

XorEncode["Orange","K"]

StringTranspose["abc","def"]

StringRotateLeft["a quark for Muster Mark ",8]

StringPermutations["ABC"]//InputForm

MakeVarList[x,8]

MakeVarList[var,{10,15}]

StringTally["One fish, two fish, red fish, blue fish"]

StringTally["One fish, two fish, red fish, blue fish",IgnoreCase->True]

"djangobcefhiklmpqrstuvwxyz"

hsMito=First@Import["ExampleData/mitochondrion.fa.gz"]//Short

PalindromeQ[str_String]:=StringReverse[str]==str

PalindromeQ["mood"]

PalindromeQ["PoP"]

words=DictionaryLookup[];

Select[words,PalindromeQ]

PalindromeQ[num_Integer]:=PalindromeQ[ToString[num]]

PalindromeQ[12522521]

words=DictionaryLookup[];

DictionaryLookup[___~~x_~~x_~~y_~~y_~~z_~~z_~~___]

With[{str1="abc",str2="def"},
Characters[{str1,str2}]]

Transpose[%]

StringJoin[%]

Clear[StringTranspose];
StringTranspose[str1_,str2_]:=StringJoin[Transpose[Characters[{str1,str2}]]]

StringTranspose["abc","def"]

StringTranspose["abcd","efg"]

stringRotateLeft[str_,n_:1]:=StringJoin[RotateLeft[Characters[str],n]]

stringRotateLeft["squeamish ossifrage"]

stringRotateLeft["squeamish ossifrage",5]

chars=Characters["cold"]

Permutations[%]

Map[StringJoin,%]

StringPermutations[str_String]:=Map[StringJoin,Permutations[Characters[str]]]

StringPermutations["ACGT"]

Prime[Range[10]]

Map[ToString,%]//InputForm

StringJoin[%]//InputForm

ToExpression[%]//InputForm

Prime[Range[12]]

NumberJoin[{x__}]:=ToExpression[StringJoin[Map[ToString,{x}]]]

SmarandacheWellin2[n_Integer?Positive]:=NumberJoin[Prime[Range[n]]]

SmarandacheWellin2[10]

SmarandacheWellin[n_Integer?Positive]:=FromDigits[Flatten[IntegerDigits@Table[Prime[i],{i,n}]]]

Timing[SmarandacheWellin[50000];]

Timing[SmarandacheWellin2[50000];]

SmarandacheWellin[50000]==SmarandacheWellin2[50000]

Table[Unique["x"],{8}]

Table[Unique["x"],{8}]

Head["x1"]

ToExpression["x1"]//Head

Symbol["x1"]//Head

StringJoin["x","8"]//FullForm

ToExpression[Map["x"<>ToString[#]&,Range[12]]]

MakeVarList[x_Symbol,n_Integer]:=ToExpression[Map[ToString[x]<>ToString[#]&,Range[n]]]

MakeVarList[x_Symbol,{n_Integer,m_Integer}]:=ToExpression[Map[ToString[x]<>ToString[#]&,Range[n,m]]]

MakeVarList[tmp,{20,30}]

MakeVarList[tmp,{-2,2}]

Clear[x]

ToString[x]<>ToString[-2]//FullForm

ToExpression[%]//FullForm

Clear[MakeVarList]

MakeVarList[x_Symbol,{n_Integer?Positive,m_Integer?Positive}]:=ToExpression[Map[ToString[x]<>ToString[#]&,Range[n,m]]]

MakeVarList[tmp,{2,4}]

str="Mississippi";
Characters[ToLowerCase@str]

Tally[%]

StringTally[str_]:=Tally[Characters[ToLowerCase@str]]

alice=Import["http://www.gutenberg.org/ebooks/28885.txt.utf-8","Text"];

StringTally[alice]//Sort

counts=Take[Sort[StringTally[alice]],-29;;-3]

BarChart[counts[[All,2]],ChartLabels->counts[[All,1]],ChartStyle->24]

ToCharacterCode[" "]

alphabet = Join[{FromCharacterCode[32]},CharacterRange["a","z"]]

coderules[n_:1]:=Thread[alphabet->RotateRight[alphabet,n]]

decoderules[n_]:=Map[Reverse,coderules[n]]

code[str_String,n_]:=Apply[StringJoin,Characters[str]/.coderules[n]]

decode[str_String,n_]:=Apply[StringJoin,Characters[str]/.decoderules[n]]

code["squeamish ossifrage",5]

decode[%,5]

PlainAlphabet=CharacterRange["a","z"]

key="django"

StringJoin[Characters@key,Complement[PlainAlphabet,Characters@key]]

CipherAlphabet[key_String]:=With[{k=Characters[key]},
StringJoin[k,Complement[CharacterRange["a","z"],k]]]

codeRules=Thread[PlainAlphabet->Characters@CipherAlphabet["django"]]

encode[str_String]:=StringJoin[Characters[str]/.codeRules]

encode["the sheik of araby"]

stringPartition[str_String,seq__]:=Map[StringJoin,Partition[Characters[str],seq]]

StringSplit[encode["the sheik of araby"],RegularExpression["\\W+"]]

StringJoin[Riffle[stringPartition[StringJoin[%],5,5,1,""]," "]]

Clear[encode];
encode[str_String,key_String,blocksize_:5]:=Module[{CipherAlphabet,codeRules,s1,s2,s3},
CipherAlphabet[k_]:=
StringJoin[Characters[k],Complement[CharacterRange["a","z"],Characters[k]]];

codeRules=Thread[CharacterRange["a","z"]->Characters@CipherAlphabet[key]];

s1=StringJoin[Characters[str]/.codeRules];
s2=StringSplit[s1,RegularExpression["\\W+"]];
s3=stringPartition[StringJoin[s2],blocksize,blocksize,1,""];
StringJoin[Riffle[s3," "]]]

encode["the sheik of araby","django",3]

StringPad[str_String,{n_}]:=StringJoin[str,Table[" ",{n}]]

StringPad["ciao",{5}]//FullForm

StringPad::badlen="Pad length `1` must be greater than the length of string `2`.";

StringPad[str_String,n_]:=With[{len=StringLength[str]},If[len>n,Message[StringPad::badlen,n,str],StringPad[str,{n-len}]]]

StringPad["ciao",8]//FullForm

StringPad["ciao",3]

StringPad[str_String,n_,m_]:=StringJoin[Table[" ",{n}],str,Table[" ",{m}]]

StringPad["ciao",3,8]//FullForm

StringInsert["ciao"," ",{1,-1}]//FullForm

StringPad2[str_String,n_,m_]:=StringInsert[str," ",Join[Table[1,{n}],Table[-1,{m}]]]

StringPad2["ciao",3,8]//FullForm

FibonacciWord[1]="0";
FibonacciWord[2]="01";

FibonacciWord[n_]:=FibonacciWord[n-1]<>FibonacciWord[n-2]

FibonacciWord[12]

Table[StringCount[FibonacciWord[i],"1"],{i,1,15}]

hsMito=First@Import["ExampleData/mitochondrion.fa.gz"];

NGrams[alphabet:{__String},n_Integer?Positive]:=Flatten[Outer[StringJoin,Apply[Sequence,Table[alphabet,{n}]]]]

bigrams=NGrams[{"A","T","G","C"},2]

data=StringCases[hsMito,Alternatives@@bigrams,Overlaps->True];

RandomSample[data,12]

Histogram[data/.Thread[bigrams->Range[Length[bigrams]]],Automatic,"PDF",ChartLabels->{None,Placed[Style[#,"SR",6]&/@bigrams,Bottom]},Ticks->{None,Automatic},AspectRatio->.4,ChartStyle->"Pastel"]

ExampleData[{"Text","AliceInWonderland"}];

SeedRandom[0];
words=DictionaryLookup[];
sample=RandomSample[words,12]

StringReplace[sample,f_?UpperCaseQ~~r___:>ToLowerCase[f]~~r]

?Decapitalize

Decapitalize[sample]

Palindromes[len_Integer]:=DictionaryLookup[w__/;(w==StringReverse[w] && StringLength[w]==len)]

Palindromes[]:=DictionaryLookup[w__/;(w==StringReverse[w] )]

Palindromes[7]

Palindromes[]

listSort={
{x___,a_?StringQ,b_?StringQ,y___}:>{x,b,a,y}/;First[ToCharacterCode[b]]<First[ToCharacterCode[a]],
{x___,a_?NumericQ,b_?NumericQ,y___}:>{x,b,a,y}/;b<a
};

{82,5,29,98,98,43,90,11,52,46,38,48}//.listSort

RandomSample@CharacterRange["a","z"]

strList={"i","w","z","p","a","s","n","l","h","q","r","d","c","f","o","y","j","u","x","t","m","b","g","e","k","v"};

strList//.listSort

text=ExampleData[{"Text","AliceInWonderland"}];

words=StringSplit[text,Characters[":;\"',.?/\-` *"]..];
Short[words,4]

Length[words]

lcwords=ToLowerCase[words];
Short[lcwords,4]

DeleteDuplicates[lcwords]//Length

words=StringSplit[text,RegularExpression["\\W+"]];
Length[words]

lcwords=StringReplace[words,RegularExpression["([A-Z])"]:>ToLowerCase["$1"]];
DeleteDuplicates[lcwords]//Length

words=DeleteDuplicates@ToLowerCase[TextWords[text]];
Length[words]

joyce=StringTake[Import["http://www.gutenberg.org/cache/epub/4217/pg4217.txt","Text"],688;;-18843];
StringTake[joyce,{74,164}]

words=TextWords[joyce];
Histogram[StringLength[words],Automatic,"PDF",Frame->True,FrameLabel->{"Word length","Frequency"},FrameTicks->{{Automatic,None},{Automatic,None}}]

sentences=TextSentences[joyce];

Histogram[Map[WordCount,sentences],Automatic,"PDF",
Frame->True,FrameLabel->{"Sentence length","Frequency"},FrameTicks->{{Automatic,None},{Automatic,None}}]

words=DictionaryLookup[__];

revwords=StringReverse[words];
RandomSample[revwords,12]

Intersection[words,revwords]

TimeConstrained[
DictionaryLookup[word__/;MemberQ[words,StringReverse[word]]],
20]

text="How many vowels do I have?";

words=TextWords[ExampleData[{"Text","AliceInWonderland"}]];
Take[words,11]

gene=GenomeData["IGHV357"];
StringCases[gene,"AA"~~_~~"T"]

words={"building","finch","fix","ratio","envy","boy","baby","faculty","honorarium"};

text="okay well er today we're er going to be carrying on with the er French \nRevolution you may have noticed i was sort of getting rather er enthusiastic \nand carried away at the end of the last one i was sort of almost er like i sort \nof started at the beginning about someone standing on a coffee table and s-, \nshouting to arms citizens as if i was going to sort of leap up on the desk and \nsay to arms let's storm the Rootes Social Building [laughter] or er let's go \nout arm in arm singing the Marseillaise or something er like that";

stopwords=Rest@Import["StopWords.dat","List"];
RandomSample[stopwords,12]

searchPhrases={"Find my favorite phone","How deep is the ocean?","What is the meaning of life?"};

Map[FilterText[#,stopwords]&,searchPhrases]

text="How many vowels do I have?";

StringCount[text,RegularExpression["[aeiou]"]]

words=TextWords[ExampleData[{"Text","AliceInWonderland"}]];

Flatten@StringCases[words,RegularExpression[".*q.*"]]

Flatten@StringCases[words,RegularExpression[".*(q|Q).*"]]

gene=GenomeData["IGHV357"];

StringCases[gene,RegularExpression["A{2,2}.T"]]

webpage=Import["http://www.wolfram.com/company/contact.cgi","HTML"];

StringCases[webpage,
RegularExpression["\\d{3}.\\d{3}.\\d{4}"]]//DeleteDuplicates

DictionaryLookup[RegularExpression["[aeiouy]+"],IgnoreCase->True]

DictionaryLookup[("a"|"e"|"i"|"o"|"u"|"y")..,IgnoreCase->True]

words=DictionaryLookup[];

StringCases[words,RegularExpression["\\w*(.)\\1(.)\\2(.)\\3\\w*"]]//Flatten

words={"building","finch","fix","ratio","envy","boy","baby","faculty","honorarium"};

rules={
(RegularExpression["(\\w+)x"]:>"$1"~~"x"~~"es"),
(RegularExpression["(\\w+)(ch)"]:>"$1"~~"$2"~~"es"),
(RegularExpression["(\\w+)([aeiou])(y)"]:>"$1"~~"$2"~~"$3"~~"s"),
(RegularExpression["(\\w+)(y)"]:>"$1"~~"ies"),
(RegularExpression["(\\w+)(i)um"]:>"$1"~~"$2"~~"a"),
(RegularExpression["(\\w+)(.)"]:>"$1"~~"$2"~~"s")
};

StringReplace[words,rules]

StringReplace[{"man","cattle"},rules]

Map[Pluralize,words]

text="okay well er today we're er going to be carrying on with the er French \nRevolution you may have noticed i was sort of getting rather er enthusiastic \nand carried away at the end of the last one i was sort of almost er like i sort \nof started at the beginning about someone standing on a coffee table and s-, \nshouting to arms citizens as if i was going to sort of leap up on the desk and \nsay to arms let's storm the Rootes Social Building [laughter] or er let's go \nout arm in arm singing the Marseillaise or something er like that";

StringReplace[text,{"\n"->""," er"->""," s-"->"",RegularExpression["\[.+\] "]->""}]

Clear[StringTally]

Options[StringTally]={IncludeCharacters->LetterCharacters};

StringTally::badopt="The option value `1` can only take on the following values: All, LetterCharacters, WordCharacters, PunctuationOnly.";

StringTally[txt_,OptionsPattern[]]:=Module[{ic=OptionValue[IncludeCharacters]},
Tally[StringCases[txt,
Which[
ic===All,RegularExpression["."],
ic===LetterCharacters,RegularExpression["[[:alpha:]]"],
ic===WordCharacters,RegularExpression["\\w"],
ic===PunctuationOnly,RegularExpression["\\W"],
True,Message[StringTally::badopt,ic]
]]]]

text=Import["http://www.gutenberg.org/ebooks/2554.txt.utf-8","Text"];

StringTally[text,IncludeCharacters->WordCharacters]//Sort

searchPhrases={"Find my favorite phone","How deep is the ocean?","What is the meaning of life?"};

tmp=StringSplit["How deep is the ocean?",Characters[":,;.!? "]..]

stopwords={"how","the","is","an"};

Apply[Alternatives,stopwords]

StringSplit[tmp,WordBoundary~~Apply[Alternatives,stopwords]~~WordBoundary,IgnoreCase->True]//Flatten

FilterText[str_String,stopwords_List]:=Module[{tmp},
tmp=StringSplit[str,Characters[":,;.!? "]..];
Flatten@StringSplit[tmp,WordBoundary~~Apply[Alternatives,stopwords]~~WordBoundary,IgnoreCase->True]
]

stopwords=Rest@Import["StopWords.dat","List"];

FilterText["What is the meaning of life?",stopwords]

Characters@StringJoin[{".","?"}]//FullForm

tmp=StringSplit["What is the meaning of life?",Characters@StringJoin[{".","?"}]..]

First@StringCases[tmp,RegularExpression["\\w+"]]

StringSplit[%,WordBoundary~~Apply[Alternatives,stopwords]~~WordBoundary]

FilterText[str_String,stopwords_List,punctuation_List]:=Module[{tmp},
tmp=StringSplit[str,Characters@StringJoin[punctuation]..];
Flatten@StringSplit[First@StringCases[tmp,RegularExpression["\\w+"]],WordBoundary~~Apply[Alternatives,stopwords]~~WordBoundary,IgnoreCase->True]
]

FilterText["What is the meaning of life?",stopwords,{".","?"}]

Map[FilterText[#,stopwords,{".","?"}]&,searchPhrases]

RandomString[{"A","T","C","G"},30,Weights->{.1,.2,.3,.4}]

RandomString[{"A","T","C","G"},{5,10},Weights->{.1,.4,.4,.1}]

RandomString[{"A","T","C","G"},{5,10},Weights->{.1,.4}]

FindWordsContaining["cite",WordPosition->"End"]

WordData["split", "PartsOfSpeech"]

sentence = "Alice was beginning to get very tired of sitting by her sister on the bank, and of having nothing to do. Once or twice she had peeped into the book her sister was reading, but ";

PreProcessString[sentence]

Collocation[%, {"Verb", "Noun"}]

Drop[Names["System`*"],5;;-5]

gcRatio[seq_String]:=Module[{gc,at},
gc=StringCount[seq,"G"|"C"];
at=StringCount[seq,"A"|"T"];
N[gc/(gc+at)]
]

gcRatio[seq_String]:=Module[{gc},
gc=StringCount[seq,"G"|"C"];
N[gc/StringLength[seq]]
]

seq="GCCCTAAGGTGGCCAAGCAC"

gcRatio[seq]

ClearAll[RandomString]

Options[RandomString]={Weights->{}};

RandomString::badwt="The length of the list of weights must be the same as the length of the list of characters.";

RandomString[{c__String},n_Integer:1,OptionsPattern[]]:=Module[{wts=OptionValue[Weights]},
Which[
Length[wts]==0,StringJoin[RandomChoice[{c},n]],
Length[wts]==Length[{c}],StringJoin[RandomChoice[wts->{c},n]],
True,Message[RandomString::badwt]
]]

RandomString[{c__String},{n_Integer,len_Integer},OptionsPattern[]]:=Module[{wts=OptionValue[Weights]},
Which[
Length[wts]==0,Map[StringJoin,RandomChoice[{c},{n,len}]],
Length[wts]==Length[{c}],Map[StringJoin,RandomChoice[wts->{c},{n,len}]],
True,Message[RandomString::badwt]
]]

RandomString[{"A","C","T"}]

RandomString[{"A","C","T"},10]

RandomString[{"A","C","T"},{4,10}]

RandomString[{"A","C","T"},{4,10},Weights->{.2,.7,.1}]

RandomString[{"A","C","T"},{4,10},Weights->{.2,.7}]

Anagrams2[word_String]:=Module[{chars=Sort[Characters[word]]},DictionaryLookup[x__/;Sort[Characters[x]]==chars]]

Anagrams2["parsley"]//Timing

Anagrams3[word_String]:=Module[{len=StringLength[word],words},
words=DictionaryLookup[w__/;StringLength[w]==len];
Select[words,Sort[Characters[#]]==Sort[Characters[word]]&]
]

Anagrams3["parsley"]//Timing

Anagrams4[word_String]:=Module[{len=StringLength[word],words},
words=DictionaryLookup[RegularExpression["\\w{"<>ToString[len]<>"}"]];
Select[words,Sort[Characters[#]]==Sort[Characters[word]]&]
]

Anagrams4["parsley"]//Timing

DictionaryLookup[___~~"cite"]

DictionaryLookup[w__/;StringEndsQ[w,"cite"]]

DictionaryLookup["cite"~~___]

DictionaryLookup[w__/;StringStartsQ[w,"cite"]]

DictionaryLookup[___~~"cite"~~___]

DictionaryLookup[w__/;StringContainsQ[w,"cite"]]

DictionaryLookup[__~~"cite"~~__]

Options[FindWordsContaining]={WordPosition->"Start"};

FindWordsContaining[str_String,OptionsPattern[]]:=Module[{wp=OptionValue[WordPosition]},
Which[
wp=="Start",DictionaryLookup[str~~___],
wp=="Middle",DictionaryLookup[__~~str~~__],
wp=="End",DictionaryLookup[___~~str],
wp=="Anywhere",DictionaryLookup[___~~str~~___]
]]

DictionaryLookup[RegularExpression["\\bcite.*\\b"]]

Options[FindWordsContaining]={WordPosition->"Start"};

FindWordsContaining[str_String,OptionsPattern[]]:=Module[{wp=OptionValue[WordPosition]},
Which[
wp=="Start",DictionaryLookup[RegularExpression[StringJoin["\\b",str,".*\\b"]]],
wp=="Middle",DictionaryLookup[RegularExpression[StringJoin["\\b.+",str,".+\\b"]]],
wp=="End",DictionaryLookup[RegularExpression[StringJoin["\\b.*",str,"\\b"]]],
wp=="Anywhere",DictionaryLookup[RegularExpression[StringJoin["\\b.*",str,".*\\b"]]]
]]

FindWordsContaining["cite"]

FindWordsContaining["cite",WordPosition->"End"]

FindWordsContaining["cite",WordPosition->"Middle"]

FindWordsContaining["cite",WordPosition->"Anywhere"]

text=ExampleData[{"Text","PrideAndPrejudice"}];

StringLength[text]

blocks=StringPartition[text,1000];

StringCases[blocks[[1]],
RegularExpression["[^A-z|0-9|\\s]"]
]

Tally[%]//InputForm

counts=Map[StringCount[#,RegularExpression["[^A-z|0-9|\\s]"]]&,blocks];

N[Mean[counts]]

text=ExampleData[{"Text","OriginOfSpecies"}];
blocks=StringPartition[text,1000];
counts=Map[StringCount[#,RegularExpression["[^A-z|0-9|\\s]"]]&,blocks];
N[Mean[counts]]

stringPartition[str_String,blocksize_]:=Map[StringJoin,Partition[Characters[str],blocksize,blocksize,1,{}]]

Clear[stringPartition]

stringPartition[str_String,seq__]:=Map[StringJoin,Partition[Characters[str],seq]]

str=RandomString[{"A","C","G","T"},20]

stringPartition[str,3,3,1,{}]

keyRL3=Transpose[{CharacterRange["a","z"],RotateLeft[CharacterRange["a","z"],3]}]

encodeChar[char_String,key_List]:=First@Cases[key,{char,next_}:>next]

encodeChar["z",keyRL3]

encode[str_String,key_List]:=StringReplace[str,RegularExpression["([a-z])"]:>encodeChar["$1",key]]

decode[str_String,key_List]:=encode[str,Map[Reverse,key]]

encode["squeamish ossifrage",keyRL3]

decode[%,keyRL3]

encode[str_String,key_List]:=StringReplace[ToLowerCase[str],RegularExpression["([a-z])"]:>encodeChar["$1",key]]

encode["Squeamish Ossifrage",keyRL3]

sentence = "Alice was beginning to get very tired of sitting by her sister on the bank, and of having nothing to do. Once or twice she had peeped into the book her sister was reading, but ";

words=TextWords[sentence]

Clear[NGrams]

NGrams[words:{__String},len_:2]:=Partition[words,len,1]

bigrams=NGrams[words]

Collocation[lis_List,{PoS1_String,PoS2_String}]:=Cases[lis,{p_/;MemberQ[WordData[p,"PartsOfSpeech"],PoS1],q_/;MemberQ[WordData[q,"PartsOfSpeech"],PoS2]}]

Collocation[bigrams,{"Noun", "Adjective"}]

text=ExampleData[{"Text","GettysburgAddress"}]

bigrams=NGrams[TextWords[text],2]

Collocation[bigrams,{"Adjective", "Noun"}]

StringCases[Names["System`*"],RegularExpression["^[[:upper:]]\\w+"]];

FunctionsWithOption[opt_Symbol]:=Module[{names,lis},
names=Flatten@StringCases[Names["System`*"],RegularExpression["^[[:upper:]]\\w+"]];
lis=DeleteCases[names,f_/;Options[Symbol[f]]==={}];
Select[lis,MemberQ[Options[Symbol[#]],opt,2]&]]

FunctionsWithOption[StepMonitor]

pts={{0,0},{1,1},{2,2}};
CentroidPlot[Triangle[pts]]

colorWheel[n_]:=Graphics[({Hue[Rescale[#,{0,2π}]],Disk[{0,0},1,{#,#+ n}]}&)/@Range[0,2 π,n],ImageSize->Small]

colorWheel[(π/256)]

circ=Circle[{.5,.5},.5];

ctext=Text[Style["Circle",8],{.5,-.2}];

tri=Triangle[{{-2,0},{-1,1},{0,0}}];

ttext=Text[Style["Triangle",8],{-1,-.2}];

rect=Rectangle[{1.5,0},{2.5,1}]

rtext=Text[Style["Rectangle",8],{2,-0.2}];

Graphics[{tri,ttext,circ,ctext,rect,rtext}]

Graphics[{
{EdgeForm[Gray],LightBlue,tri},ttext,
{Thick,Gray,circ},ctext,
{EdgeForm[Gray],LightGreen,rect},rtext}]

Map[Cuboid,RandomReal[1,{2,3}]]

cubes=Map[Cuboid,RandomReal[1,{6,3}]];

Graphics3D[{Opacity[.5],cubes}]

Graphics3D[{Opacity[.25],Cuboid[{-0.5,-0.5,-0.5}]},Boxed->False,Axes->Automatic]

Graphics3D[{Opacity[.25],Cuboid[{-.5,-.5,-.5}],Rotate[Cuboid[{-.5,-.5,-.5}],45 °,{0,0,1}]}]

Manipulate[
Graphics3D[Rotate[Cuboid[{-.5,-.5,-.5}],θ,{0,0,1}],PlotRange->1],
{θ,0,2π}]

pts=RandomReal[{0,1},{24,3}];

Graphics3D[{
{Opacity[.3],Line[Subsets[pts,{2}]]},
{Red,PointSize[Medium],Point[pts]}}]

Graphics3D[{
{Opacity[.3],Line[Subsets[pts,{2}]]},
{Red,PointSize[Medium],Point[pts]}},PlotLabel->StringForm["`1` vertices, `2` edges", Length[pts], 
    Binomial[Length[pts], 2]]]

randomcoords:=Point[RandomVariate[NormalDistribution[0,1],{1,2}]]

randomsize:=PointSize[RandomReal[{.01,.1}]]

randomcolor:=RandomColor[ColorSpace->"Hue"]

pts=Table[{randomcolor,randomsize,randomcoords},{500}];

Graphics[pts]

With[{n=500},
Graphics[MapThread[{#1,PointSize[#2],Point[#3]}&,{RandomColor[n,ColorSpace->"Hue"],RandomReal[{.01,.1},n],RandomVariate[NormalDistribution[0,1],{n,2}]}]
]]

First[RealDigits[N[Pi,12],2]]

2%-1

ListLinePlot[
With[{digits=50000},
Accumulate[2First[RealDigits[N[Pi,digits],2]]-1]
]]

With[{digs=First[RealDigits[N[Pi,50000],2]]},
ListLinePlot[Accumulate[Partition[digs,2,2]/. {{0,0}->{-1,0},{1,1}->{0,-1}}],
AspectRatio->Automatic]]

Clear[x,y,r]

soln=Solve[{(((x-1))^2)+(((y-1))^2)==2,(((x+3))^2)+(((y-4))^2)==(r^2)},{x,y}]

Solve[{
(x/. soln[[1]])==(x/. soln[[2]]),
(y/. soln[[1]])==(y/. soln[[2]])},
r]

Cases[%,{r->_?Positive}]

circ=Circle[{1,1},(Sqrt[2])];

r1=5-(Sqrt[2]);
r2=5+(Sqrt[2]);

Graphics[{circ,Circle[{-3,4},r1],Circle[{-3,4},r2]},Axes->Automatic]

dashc1={Red,Dashing[{.025,.025}],Circle[{-3,4},r1]};
dashc2={Red,Dashing[{.05,.05}],Circle[{-3,4},r2]};

Graphics[{
{Thick,circ},
dashc1,dashc2},Axes->Automatic]

sinplot=Plot[Sin[x],{x,0,2 π}]

Short[coords=Cases[sinplot,Line[{x__}]:>x,Infinity],2]

Short[lines=Map[Line[{{#[[1]],0},#}]&,coords],2]

Show[sinplot,Graphics[{Thickness[.001],lines}]]

TriangleMedians[Triangle[{p1_,p2_,p3_}]]:=Module[{midpts},
midpts=(#1+#2)/2&@@@Subsets[{p1,p2,p3},{2}];
MapThread[Line[{#1,#2}]&,{{p3,p2,p1},midpts}]]

CentroidPlot[Triangle[{p1_,p2_,p3_}],opts:OptionsPattern[Graphics]]:=
Graphics[{
{LightBlue,EdgeForm[Blue],Triangle[{p1,p2,p3}]},
{Blue,PointSize[Medium],Point[{p1,p2,p3}]},
{Red,PointSize[Medium],Point@RegionCentroid[Triangle[{p1,p2,p3}]]},
{Gray,TriangleMedians[Triangle[{p1,p2,p3}]],PointSize[Medium],Point[(#1+#2)/2&@@@Subsets[{p1,p2,p3},{2}]]}
},opts]

SeedRandom[15];
Table[CentroidPlot[Triangle[RandomInteger[{-5,5},{3,2}]]],{3}]

CentroidPlot::collinpts="The points `1` are collinear, giving a degenerate triangle.";

pts={{0,0},{1,1},{2,2}};
Area[Triangle[pts]]

SignedArea[Triangle[{v1_,v2_,v3_}]]:=(1/2) Det[{v1,v2,v3}/.{x_,y_}:>{x,y,1}]

SignedArea[Triangle[pts]]

If[SignedArea[pts]==0,Message[CentroidPlot::collinpts,pts],else_body_of_function]

CentroidPlot[Triangle[{p1_,p2_,p3_}],opts:OptionsPattern[Graphics]]:=
If[SignedArea[Triangle[{p1,p2,p3}]]==0,Message[CentroidPlot::collinpts,{p1,p2,p3}],

Graphics[{
{LightBlue,EdgeForm[Blue],Triangle[{p1,p2,p3}]},
{Blue,PointSize[Medium],Point[{p1,p2,p3}]},
{Red,PointSize[Medium],Point@RegionCentroid[Triangle[{p1,p2,p3}]]},
{Gray,TriangleMedians[Triangle[{p1,p2,p3}]],PointSize[Medium],Point[(#1+#2)/2&@@@Subsets[{p1,p2,p3},{2}]]}
},opts]
]

CentroidPlot[Triangle[pts]]

CentroidPlot[Triangle[RandomInteger[{-5,5},{3,2}]]]

{p1,p2,p3}={{-1,0},{0,2},{1,0}};
center=First@Circumsphere[{p1,p2,p3}]

lines=InfiniteLine/@Subsets[{p1,p2,p3},{2}]

pbs=Map[RegionNearest[#,center]&,lines]

perpLines=Map[Line[{center,#}]&,Map[RegionNearest[#,center]&,lines]]

Graphics[{
{Blue,PointSize[Medium],Point[{p1,p2,p3}]},
{EdgeForm[Gray],LightBlue,Triangle[{p1,p2,p3}]},
{Blue,Circumsphere[{p1,p2,p3}]},
{Blue,PointSize[Large],Point@center},
{Purple,perpLines,PointSize[Large],Point@pbs}
}]

{p1,p2,p3}={{-1,0},{0,2},{1,0}};

lines=Map[InfiniteLine,Subsets[{p1,p2,p3},{2}]]

altPts=MapThread[RegionNearest[#1,#2]&,{lines,Reverse[{p1,p2,p3}]}]

altLines=MapThread[Line[{#1,#2}]&,{Reverse@{p1,p2,p3},altPts}]

Graphics[{
{Blue,PointSize[Medium],Point[{p1,p2,p3}]},
{EdgeForm[Gray],LightBlue,Triangle[{p1,p2,p3}]},
{Purple,PointSize[Large],Point@altPts,altLines}
}]

Perimeter[Triangle[pts:{p1_,p2_,p3_}]]:=RegionMeasure[Line[pts/.{p_,pn__}:>{p1,pn,p1}]]

inCenter[pts:{p1_,p2_,p3_}]:=Module[{a,b,c,p=Perimeter[Triangle[pts]]},
{a,b,c}={Norm[p2-p3],Norm[p1-p3],Norm[p2-p1]};
{(a p1[[1]]+b p2[[1]]+ c p3[[1]])/p,(a p1[[2]]+b p2[[2]]+ c p3[[2]])/p}]

inRadius[pts:{pt1_,pt2_,pt3_}]:=EuclideanDistance[RegionNearest[InfiniteLine[pt1,pt3],inCenter[pts]],inCenter[pts]]

{p1,p2,p3}={{-1,0},{0,2},{1,0}};
pts={p1,p2,p3};
Graphics[{
{EdgeForm[Gray],LightBlue,Triangle[pts]},
{PointSize[Large],Point[pts]},
{Red,Circle[inCenter@pts,inRadius[pts]],PointSize[Large],Point[inCenter@pts]},
{Map[Line[{inCenter@pts,#}]&,pts]}
},Axes->True]

𝒟=NormalDistribution[0,1];
σ=StandardDeviation[𝒟];
μ=Mean[𝒟];

Plot[PDF[𝒟,x],{x,-4,4},
Filling->Axis,Epilog->{Gray,Line[{{{μ+σ,0},{μ+σ,PDF[𝒟,μ+σ]}},{{μ-σ,0},{μ-σ,PDF[𝒟,μ-σ]}},{{μ+2 σ,0},{μ+2 σ,PDF[𝒟,μ+2 σ]}},{{μ-2 σ,0},{μ-2 σ,PDF[𝒟,μ-2 σ]}}}]},
AxesOrigin->{-4,0},
Ticks->{{{-2 σ,"-2σ"},{-σ,"-σ"},{μ,"μ"},{σ,"σ"},{2 σ,"2σ"}},Automatic},
AspectRatio->0.4,
PlotLabel->StringForm["Normal distribution: μ=`1`, σ=`2`",μ,σ]]

sdLine[𝒟_,μ_,σ_]:=Line[{{{μ+σ,0},{σ+μ,PDF[𝒟,μ+σ]}},{{μ-σ,0},{-σ+μ,PDF[𝒟,μ-σ]}}}]

Plot[PDF[𝒟,x],{x,-4,4},
Filling->Axis,Epilog->{Gray,Thickness[.0035],sdLine[𝒟,μ,σ],sdLine[𝒟,μ,2 σ]},AxesOrigin->{-4,0},
Ticks->{{{-2 σ,"-2σ"},{-σ,"-σ"},{μ,"μ"},{σ,"σ"},{2 σ,"2σ"}},Automatic},
AspectRatio->0.4,
PlotLabel->StringForm["Normal distribution: μ=`1`, σ=`2`",μ,σ]]

With[{a=5,b=3},
f=(Sqrt[(a^2)-(b^2)]);
Graphics[{
Circle[{0,0},{a,b}],
Point[{f,0}],Point[{-f,0}]
},Axes->Automatic]]

ChemicalData["AminoAcids"]

StringCases[ChemicalData["Properties"],__~~"Diagram"|(__~~"Plot")]//Flatten

Manipulate[
Plot[f[x],{x,0,2π}],
{f,{Sin,Cos,Tan}}]

Manipulate[
Plot[f[x],{x,0,2π}],
{f,{Sin,Cos,Tan},ControlType->PopupMenu}]

Manipulate[
f=If[(a^2)-(b^2)≥0,{(Sqrt[Abs[(a^2)-(b^2)]]),0},{0,(Sqrt[Abs[(a^2)-(b^2)]])}];
Graphics[{
Circle[{0,0},{a,b}],
Point[f],Point[-f]
},PlotRange->Max[a,b]+.1],
{a,1,5},{b,1,5}]

AminoAcidPlot[aa_String,diagram_:"ColorStructureDiagram"]:=Labeled[Framed[ChemicalData[aa,diagram],ImageSize->All],ChemicalData[aa,"Name"],LabelStyle->Directive["Menu",9]]

AminoAcidPlot[aa_Entity,diagram_:"ColorStructureDiagram"]:=Labeled[Framed[ChemicalData[aa,diagram],ImageSize->All],ChemicalData[aa,"Name"],LabelStyle->Directive["Menu",9]]

AminoAcidPlot["Glycine"]

AminoAcidPlot[(Entity["glycine", Entity["Chemical","Glycine"], "Entity[\"Chemical\", \"Glycine\"]", "chemical"])]

Manipulate[
AminoAcidPlot[aminoacid,diagram],
{{aminoacid,"LAlanine","Amino acid"},aa},
{diagram,{"StructureDiagram","CHColorStructureDiagram","CHStructureDiagram","ColorStructureDiagram","MoleculePlot","SpaceFillingMoleculePlot"}},
Initialization:>{aa=ChemicalData["AminoAcids"]},SynchronousUpdating->False,SaveDefinitions->True]

Manipulate[CentroidPlot[Triangle[pts],PlotRange->{-0.2,2.2}],
{{pts,{{-1,0},{0,2},{1,0}}},Locator},SaveDefinitions->True]

Manipulate[
Graphics[
Table[Circle[r/4{Cos[t],Sin[t]},1.1-r],{r,.2,1,.05}],
PlotRange->1],
{t,0,2π,.1}]

Manipulate[Grid[{{Graphics[{Circle[],Blue,PointSize[.04],Point[{Cos[θ],Sin[θ]}]},Axes->True],Plot[Sin[x],{x,0,2 π},Epilog->{Blue,Line[{{θ,0},{θ,Sin[θ]}}],PointSize[.025],Point[{θ,Sin[θ]}]}]}},Frame->All],{θ,0,2 π}]

<<EPM`RandomWalks`

rw=RandomWalk[1000,Dimension->2,LatticeWalk->True];

Animate[
Graphics[Line[Take[rw,n]]],
{n,2,Length[rw],1},AnimationRunning->False]

Manipulate[
Graphics[Line[Take[rw,n]],PlotRange->{xran,yran}],
{n,2,Length[rw],1},
Initialization:>{
rw=RandomWalk[1000,Dimension->2,LatticeWalk->True];{xran,yran}=Map[{Min[#1],Max[#1]}&,Transpose[rw]]},SaveDefinitions->True]

Manipulate[
ShowWalk@RandomWalk[steps,Dimension->dim,LatticeWalk->latticeQ],
{steps,{100,250,500,750,1000,10000}},
{{dim,1,"Dimension"},{1,2,3}},
{{latticeQ,True,"Lattice walk"},{True,False}},
Initialization:>Needs["EPM`RandomWalks`"],SaveDefinitions->True]

Manipulate[
Graphics[{
Red,Arrow[{{0,0},pt1}],
Blue,Arrow[{{0,0},pt2}],
Green,Arrow[{{0,0},pt1+pt2}],
Dashed,Orange,Line[{pt1,pt1+pt2,pt2}]},
PlotRange-> 6,Axes-> True,GridLines-> Automatic],
{{pt1,{1,4},"Red vector"},{-5,-5},{5,5}},{{pt2,{3,1},"Blue vector"},{-5,-5},{5,5}},
ControlPlacement-> Left]

DynamicModule[{pt={0,.5}},
Graphics[{
LightBlue,Rectangle[{-1,-1},{1,1}],
Pink,Circle[],Thick,Circle[{0,0},.5],
Locator[Dynamic[pt,(pt=.5Normalize[#])&]]
},PlotRange->1.25]]

pts=RandomReal[1,{25,2}];

Graphics[GraphicsComplex[pts,Point@Range[Length[pts]]],Axes->Automatic]

tour=Last[FindShortestTour[pts]];
Graphics[GraphicsComplex[pts,{Line[tour],Red,PointSize[Medium],Point[tour]}],Axes->Automatic]

Manipulate[
DynamicModule[{pts=RandomReal[1,{20,2}],tour},
tour=Dynamic[Last[FindShortestTour[pts]]];
EventHandler[
Dynamic[Graphics[GraphicsComplex[pts,If[Not[showtour],Point@Range[Length[pts]],{Line[tour],Red,PointSize[Medium],Point[tour]}]],Axes->Automatic]],
{"MouseClicked":>(pts=RandomReal[1,{20,2}])}
]],
{{showtour,False,"Show tour"},{True,False}},
ContentSize->All]

pts=RandomReal[1,{28,2}];
ℛ=ConvexHullMesh[pts]

MeshPrimitives[ℛ,0];
Take[%,2]

MeshPrimitives[ℛ,1];
Take[%,2]

ConvexHullPlot[pts,Axes->Automatic]

Clear[vertices,n,α]

vertices[n_]:=Table[{Cos[((2 π α)/n)],Sin[((2 π α)/n)]},{α,0,n}]

hexagon=Polygon[vertices[6]];Graphics[{EdgeForm[Gray],LightGray,hexagon}]

Graphics[{
EdgeForm[Gray],LightGray,
Table[GeometricTransformation[hexagon,TranslationTransform[{3 i+(3/4) ((((-1))^j)+1),(((Sqrt[3]) j)/2)}]
],{i,5},{j,8}]
}]

gr1=Graphics[{
EdgeForm[Gray],LightGray,
Table[Translate[hexagon,{3 i+(3/4) ((((-1))^j)+1),(((Sqrt[3]) j)/2)}],{i,5},{j,8}]
}]

Count[gr1,_Polygon,Infinity]

Clear[hexagon];
hexagon[{x_,y_}]:=Table[{Cos[((2 π i)/6)]+x,Sin[((2 π i)/6)]+y},{i,1,6}]

gr2=Graphics[{EdgeForm[Gray],LightGray,Polygon[Flatten[Table[hexagon[{3 i+(3/4) ((((-1))^j)+1),(((Sqrt[3]) j)/2)}],{i,5},{j,8}],1]]
}]

Count[gr2,_Polygon,Infinity]

?GraphicsComplex

walk=RandomWalk[5 (10^5)];

Short[walk,2]

Graphics[GraphicsComplex[walk,{
Line@Range[Length[walk]]
}]]

Graphics[GraphicsComplex[walk,{
RGBColor[.6,.4,.5],Thickness[Tiny],Line@Range[Length[walk]]
}],Axes->Automatic]//Timing

ShowWalkGC[coords:{{_,_}..}]:=Graphics[
GraphicsComplex[coords,Line[Range[Length[coords]]]]]

ShowWalkGC[RandomWalk[1500,Dimension->2]]

Clear[ShowWalkGC];ShowWalkGC[coords:{{_,_}..},opts:OptionsPattern[Graphics]]:=Graphics[
GraphicsComplex[coords,
{ColorData[1][1],Line[Range[Length[coords]]]}
],opts,
Axes->True,AspectRatio->Automatic]

ShowWalkGC[RandomWalk[1500,Dimension->2]]

ShowWalkGC[coords:{{_,_,_}..},opts:OptionsPattern[Graphics3D]]:=Graphics3D[GraphicsComplex[coords,
{ColorData[1][1],AbsoluteThickness[1],Line[Range[Length[coords]]]}],
opts,Axes->True,AspectRatio->Automatic]

ShowWalkGC[RandomWalk[2500,Dimension->3]]

walk=RandomWalk[250000];
Timing[ShowWalk[walk,AspectRatio->Automatic]]

Timing[ShowWalkGC[walk]]

xmin=0;xmax=3;
ymin=0;ymax=3;
zmin=0;zmax=3;
Table[{{x,ymin,zmin},{x,ymax,zmin}},{x,xmin,xmax}]

gridX=Table[{{xmin,y,z},{xmax,y,z}},{y,ymin,ymax},{z,zmin,zmax}];
gridY=Table[{{x,ymin,z},{x,ymax,z}},{x,xmin,xmax},{z,zmin,zmax}];
gridZ=Table[{{x,y,zmin},{x,y,zmax}},{x,xmin,xmax},{y,ymin,ymax}];

gr1=Graphics3D[{
Map[Line,gridX,{2}],
Map[Line,gridY,{2}],
Map[Line,gridZ,{2}]
},Boxed->False]

Count[gr1,_Line,Infinity]

gr2=Graphics3D[{
Map[Line,gridX],
Map[Line,gridY],
Map[Line,gridZ]
},Boxed->False]

Count[gr2,_Line,Infinity]

pts=RandomReal[1,{8,2}];

ℛ=ConvexHullMesh[pts]

Head[ℛ]

MeshPrimitives[ℛ,0]

MeshPrimitives[ℛ,1]

MeshPrimitives[ℛ,2]

ConvexHullPlot[pts_,opts:OptionsPattern[Graphics]]:=Module[{ℛ},ℛ=ConvexHullMesh[pts];Show[ℛ,Graphics[{Point[pts],Red,PointSize[Medium],MeshPrimitives[ℛ,0]}],opts]]

pts=RandomReal[{-100,100},{60,2}];

ConvexHullPlot[pts,Axes->Automatic,ImageSize->Small]

Options[ConvexHullPlot]=Join[{Dimension->2},Options[Graphics],Options[Graphics3D]];

ConvexHullPlot::baddim="The value `1` of the Dimension option should be either 2 or 3";

ConvexHullPlot[pts_,opts:OptionsPattern[]]:=Module[{ℛ,dim=OptionValue[Dimension]},
ℛ=ConvexHullMesh[pts];
Which[
dim==2,Show[{ℛ,Graphics[{Point[pts],Red,PointSize[Medium],MeshPrimitives[ℛ,0]}]},
FilterRules[{opts},Options[Graphics]]],
dim==3,Show[{ℛ,Graphics3D[{Point[pts],Red,PointSize[Medium],MeshPrimitives[ℛ,0]}]},
FilterRules[{opts},Options[Graphics3D]]],
True,Message[ConvexHullPlot::baddim,dim]
]
]

pts=RandomReal[1,{40,3}];

ConvexHullPlot[pts,Dimension->3,Boxed->True,Background->Gray]

ConvexHullPlot[pts,Dimension->4]

RandomWalkPi[d_,base_/;base>2]:=Module[{digits,angles,rules},
digits=First[RealDigits[N[π,d],base]];
angles=Rest@Range[0.,2π,2π/(base)];rules=MapThread[#1->#2&,{Range[0,base-1],angles}];
Accumulate[Map[{Cos[#],Sin[#]}&,digits/.rules]]
]

ListLinePlot[RandomWalkPi[10000,5],AspectRatio->Automatic]

walk=RandomWalkPi[10000,5];
len=Length[walk];

Graphics[GraphicsComplex[walk,{AbsoluteThickness[.2],Line[Range[len]]}],AspectRatio->Automatic]

Graphics[GraphicsComplex[walk,Map[{Hue[((#[[1]])/len)],AbsoluteThickness[.25],Line[#]}&,Partition[Range[2,len],2,1]]],AspectRatio->Automatic]

VennDiagram[A⊻B,{A,B}]

VennDiagram[(A∨B∨C)&&¬(A∧B∧C),{A,B,C}]

DotPlot[seq2,seq1,WindowSize->3,FrameLabel->{"DQ023146.1","DQ232610.1"}]

Import["H5N1ChickenDQ023146.1.fasta",{"FASTA","Accession"}]

DotPlot["H5N1ChickenDQ023146.1.fasta","H5N1DuckDQ232610.1.fasta",WindowSize->3]

Options[ComplexListPlot]=Options[ListPlot];

ComplexListPlot[points_,opts:OptionsPattern[]]:=
ListPlot[Map[{Re[#],Im[#]}&,points],opts,PlotStyle->{Red,PointSize[.025]},AxesLabel->{Style["Re",8],Style["Im",8]},LabelStyle->Directive["Menu",6]]

ComplexListPlot[{-1+I,2+I,1-2I,0,1},PlotStyle->{Blue,PointSize[Medium]}]

ComplexRootPlot[poly_,z_,opts:OptionsPattern[]]:=ComplexListPlot[z/.NSolve[poly==0,z],opts,AspectRatio->Automatic]

ComplexRootPlot[Cyclotomic[17,z],z,GridLines->Automatic]

Clear[f,x,y,g]

f[x_,y_]:=Sin[2x-Cos[y]];
g[x_,y_]:=Sin[x-Cos[2y]];

Plot3D[{f[x,y],g[x,y]},{x,-π,π},{y,-π,π},Mesh->{{0.}},MaxRecursion->4,MeshFunctions->(f[#1,#2]-g[#1,#2]&),MeshStyle->{Thick,Red},PlotStyle->{Cyan,Yellow}]

Clear[VennDiagram]

VennDiagram[f_,vars:{A_,B_}]:=Module[{regions,x,y,c1={-.5,0},c2={.5,0}},
regions=Apply[(((x-#1))^2)+(((y-#2))^2)<1&,{c1,c2},{1}];
RegionPlot[{regions,Apply[f,regions]},{x,-2,2},{y,-2,2},Frame->True,FrameTicks->None,PlotLabel->f@@vars,AspectRatio->Automatic,PlotRange->{{-2,2},{-1.2,1.2}},
PlotStyle->{White,White,LightBlue},
MaxRecursion->4,
Epilog->{Text[First[vars],{-.5,.75}],Text[Last[vars],{.5,.75}]}]
]

VennDiagram[Xor,{A,B}]

expr=(a∨b)&&¬(a∧b);
vars={a,b};

expr/.Thread[vars->{#1,#2}]&

Clear[VennDiagram]

VennDiagram[expr_,vars:{__}/;Length[vars]==2]:=Module[{c1,c2,regions,x,y,f},
{c1,c2}={{-1/2,0},{1/2,0}};
regions=(((x-#1))^2)+(((y-#2))^2)<1&@@@{c1,c2};
f=expr/.Thread[vars->{#1,#2}]&;
RegionPlot[{regions,f@@regions},{x,-2,2},{y,-3/2,3/2},AspectRatio->Automatic,FrameTicks->None,FrameLabel->TraditionalForm[expr],
PlotStyle->{White,White,LightBlue},
MaxRecursion->4,
Epilog->{Text[vars[[1]],{-1/2,3/4}],Text[vars[[2]],{1/2,3/4}]}
]]

VennDiagram[(a∨b)&&¬(a∧b),{a,b}]

{c1,c2,c3}={{-1/2,0},{1/2,0},{0,(Sqrt[3])/2}};regions=(((x-#1))^2)+(((y-#2))^2)<1&@@@{c1,c2,c3}

Graphics[{Circle[c1],Circle[c2],Circle[c3],
Text[A,{-1/2,.75}],Text[B,{1/2,.75}],Text[C,{0,1.6}]}]

expr=(a∨b∨c)&&¬(a∧b∧c);
vars={a,b,c};

expr/.Thread[vars->{#1,#2,#3}]&

VennDiagram[expr_,vars:{__}/;Length[vars]==3]:=Module[{c1,c2,c3,regions,x,y,f},
{c1,c2,c3}={{-1/2,0},{1/2,0},{0,(Sqrt[3])/2}};
regions=(((x-#1))^2)+(((y-#2))^2)<1&@@@{c1,c2,c3};
f=expr/.Thread[vars->{#1,#2,#3}]&;
RegionPlot[{regions,f@@regions},{x,-2,2},{y,-3/2,5/2},AspectRatio->Automatic,FrameTicks->None,FrameLabel->TraditionalForm[expr],
PlotStyle->{White,White,White,LightBlue},BoundaryStyle->GrayLevel[.65],
Epilog->{Text[vars[[1]],{-1/2,-.75}],Text[vars[[2]],{1/2,-.75}],Text[vars[[3]],{0,1.6}]}
]]

VennDiagram[(a∨b∨c)&&¬(a∧b∧c),{a,b,c}]

Manipulate[Row[{
TruthTable[f[A,B],{A,B}],
VennDiagram[A∨B,{A,B}]
}],{{f,Xor,"Logical function"},{And,Or,Xor,Implies,Nand,Nor}},SaveDefinitions->True]

seq1=First@Import["H5N1ChickenDQ023146.1.fasta"];
seq2=First@Import["H5N1DuckDQ232610.1.fasta"];

<<EPM`

With[{windowsize=4},
Take[stringPartition[seq1,windowsize,1,1,{}],12]
]

Options[DotPlot]=Join[{WindowSize->1},Options[ArrayPlot]];

DotPlot[p1_,p2_,opts:OptionsPattern[]]:=Module[{w=OptionValue[WindowSize]},
ArrayPlot[Outer[Boole[#1==#2]&,stringPartition[p1,w,1,1,{}],stringPartition[p2,w,1,1,{}]],
FilterRules[{opts},Options@ArrayPlot],Frame->True]]

DotPlot[seq2,seq1,WindowSize->4,FrameLabel->{"DQ023146","DQ232610"},ColorRules->{1->Black,0->LightYellow},ImageSize->Small]

DotPlot[file1_,file2_,opts:OptionsPattern[]]:=Module[{w=OptionValue[WindowSize],p1,p2,lab1,lab2},
p1=First@Import[file1,{"FASTA","Sequence"}];
p2=First@Import[file2,{"FASTA","Sequence"}];
lab1=First@Import[file1,{"FASTA","Accession"}];
lab2=First@Import[file2,{"FASTA","Accession"}];
ArrayPlot[Outer[Boole[#1==#2]&,
stringPartition[p1,w,1,1,{}],
stringPartition[p2,w,1,1,{}]
],FilterRules[{opts},Options@ArrayPlot],Frame->True,FrameLabel->{lab1,lab2}]]

DotPlot["H5N1ChickenDQ023146.1.fasta","H5N1DuckDQ232610.1.fasta",WindowSize->3,ImageSize->Small]

Hypocycloid[{a_,b_},θ_]:={(a-b)Cos[θ]+b Cos[θ ((a-b)/b)],(a-b)Sin[θ]-b Sin[θ ((a-b)/b)]}

HypocycloidPlot[R_,r_,θ_]:=Module[{center},
center[th_,R1_,r2_]:=(R1-r2) {Cos[th],Sin[th]};

Show[{
ParametricPlot[Hypocycloid[{R,r},t],{t,0,θ},PlotStyle->Red,Axes->None],

Graphics[{{Blue,Thick,Circle[{0,0},R]},{Circle[center[θ,R,r],r]},{PointSize[.02],Point[center[θ,R,r]]},{Thick,Line[{center[θ,R,r],Hypocycloid[{R,r},θ]}]},{Red,PointSize[.02],Point[Hypocycloid[{R,r},θ]]}}]

},PlotRange->If[r<R,2R,2r],GridLines->Automatic,ImageSize->Medium]]

Manipulate[HypocycloidPlot[1,3,θ],{θ,0.1,6π },SaveDefinitions->True]

EpicycloidPlot[R_,r_,θ_]:=Module[{epicycloid,center},
epicycloid[{a_,b_},t_]:={(a+b)Cos[t]-b Cos[t ((a+b)/b)],(a+b)Sin[t]+b Sin[t ((a+b)/b)]};center[th_,R1_,r2_]:=(R1+r2){Cos[th],Sin[th]};
Show[{
ParametricPlot[epicycloid[{R,r},t],{t,0,θ},PlotStyle->Red,Axes->None,ImageSize->Small],
Graphics[{
{Blue,Thick,Circle[{0,0},R]},
{Circle[center[θ,R,r],r]},
{PointSize[.015],Point[center[θ,R,r]]},
{Thick,Line[{center[θ,R,r],epicycloid[{R,r},θ]}]},
{Red,PointSize[.015],Point[epicycloid[{R,r},θ]]}
}]},PlotRange->1.5(R+r),GridLines->Automatic]]

EpicycloidPlot[3,1,2π]

Manipulate[EpicycloidPlot[R,r,θ],
{θ,0+0.01,2Denominator[(R-r)/r]π},
{R,{3,4,5,6,7,8},Setter},{r,{1,2,3,4,5},Setter},SaveDefinitions->True]

Options[PathPlot]=Join[{ClosedPath->True},Options[Graphics]];

PathPlot[lis_List,opts:OptionsPattern[]]:=Module[{coords=lis},If[OptionValue[ClosedPath],coords=coords/. {a_,b__}:>{a,b,a}];Graphics[{Line[coords],PointSize[Medium],Red,Point[coords]},FilterRules[{opts},Options[Graphics]]]]

SeedRandom[424];
coords=RandomReal[1,{10,2}];

PathPlot[coords,ClosedPath->True,GridLines->Automatic]

SimplePath3[lis_]:=Module[{base,angle,sorted},
base=Last[SortBy[lis,Last]];
angle[a_,b_]:=ArcTan@@(b-a);sorted=Sort[Complement[lis,{base}],angle[base,#1]≤angle[base,#2]&];Join[{base},sorted]]

pts=RandomReal[1,{20,2}];

PathPlot[SimplePath3[pts]]

SimplePath1[lis_List]:=Module[{base,angle,sorted},
base=First[SortBy[lis,Last]];
angle[a_,b_]:=ArcTan@@(b-a);
sorted=Sort[Complement[lis,{base}],angle[base,#1]≤angle[base,#2]&];Join[{base},sorted]]

pts=RandomReal[1,{40,2}];

PathPlot[SimplePath1[pts]]

SimplePathCM[lis_]:=Module[{centroid,angle},
centroid=RegionCentroid[Polygon@lis];
angle[a_,b_]:=Apply[ArcTan,b-a];Sort[lis,angle[centroid,#1]≤angle[centroid,#2]&]]

PathPlot[SimplePathCM[pts]]

ChemicalSpaceFillingPlot[file_String]:=Module[{elements,pos,radii,names,colors,labels},

{pos,elements}=First/@Import[file,{{"VertexCoordinates","VertexTypes"}}];

radii=QuantityMagnitude@Map[ElementData[#,"VanDerWaalsRadius"]&,elements];

labels=DeleteDuplicates[elements];
names=ElementData[#,"StandardName"]&/@labels;
colors=labels/.ColorData["Atoms","ColorRules"];

Legended[
Graphics3D[{Specularity[White,50],
MapThread[{ColorData["Atoms",#1],Sphere[#2,#3]}&,{elements,pos,radii}]
},Lighting->"Neutral"],
SwatchLegend[colors,names,LegendMarkers->"SphereBubble",LabelStyle->Directive[FontSize->7.5]]
]
]

ChemicalSpaceFillingPlot["5hydroxytryptamine.sdf"]

{p1,p2,p3}={{-1,0},{1,2},{2,0}};
lines=Map[InfiniteLine,Subsets[{p1,p2,p3},{2}]];
altPts=MapThread[RegionNearest[#1,#2]&,{lines,Reverse@{p1,p2,p3}}];altLines=MapThread[Line[{#1,#2}]&,{altPts,Reverse@{p1,p2,p3}}];
iLines=InfiniteLine@@@altLines;
center={x,y}/.First@Solve[Map[({x,y}∈#)&,iLines],{x,y}];
Graphics[{
{LightBlue,EdgeForm[Gray],Triangle[{p1,p2,p3}]},
{Blue,PointSize[Medium],Point[{p1,p2,p3}]},
Point@altPts,PointSize[Large],Point@center,
{Gray,iLines}
},PlotLabel->"Orthocenter"]

DynamicModule[{pts=5{{-1,0},{1,2},{2,0}}},
LocatorPane[Dynamic[pts,Appearance->Tiny],
Dynamic@Graphics[{
{EdgeForm[Gray],LightBlue,Triangle[pts]},
{Gray,Map[InfiniteLine,Subsets[pts,{2}]]},

{Point@MapThread[RegionNearest[#1,#2]&,{Map[InfiniteLine,Subsets[pts,{2}]],Reverse@pts}]},

MapThread[InfiniteLine[{#1,#2}]&,{MapThread[RegionNearest[#1,#2]&,{Map[InfiniteLine,Subsets[pts,{2}]],Reverse@pts}],Reverse@pts}]

}]]]

<<EPM`

<<EPM`RandomWalks`

walk=RandomWalk[10000,Dimension->2,LatticeWalk->False];
𝒯=RadiusOfGyrationTensor[walk]

{λ1,λ2}=Eigenvalues[𝒯]

{{v1x,v1y},{v2x,v2y}}=Eigenvectors[𝒯]

{cmx,cmy}=Mean[walk]

ev1=(v1y/v1x)(x-cmx)+cmy//Expand

ev2=(v2y/v2x)(x-cmx)+cmy//Expand

EigenvectorPlot[data:{{_,_}..},tensor_,opts:OptionsPattern[ListLinePlot]]:=Module[{T=tensor,cmx,cmy,λ1,λ2,v1x,v1y,v2x,v2y},
{λ1,λ2}=Eigenvalues[T];
{cmx,cmy}=Mean[data];
{{v1x,v1y},{v2x,v2y}}=Eigenvectors[T];
Show[{
ListLinePlot[data,opts,PlotStyle->Thin],
Graphics[{
Line[{{cmx-λ1,cmy-((v1y λ1)/v1x)},{cmx+λ1,cmy+((v1y λ1)/v1x)}}],
Line[{{cmx-λ2,cmy-((v2y λ2)/v2x)},{cmx+λ2,cmy+((v2y λ2)/v2x)}}],
PointSize[Large],Red,Point@Mean[data]}]
},AspectRatio->Automatic]]

<<EPM`RandomWalks`

SeedRandom[4];
walk=RandomWalk[10000,Dimension->2,LatticeWalk->False];
𝒯=RadiusOfGyrationTensor[walk]

EigenvectorPlot[walk,𝒯]

Anagrams1[word_String]:=Module[{words},
words=Map[StringJoin,Permutations[Characters[word]]];
DictionaryLookup[x__/;MemberQ[words,x]]]

Timing[Anagrams1["alerts"]]

Anagrams2[word_String]:=Module[{chars=Characters[word],words},
words=Map[StringJoin,Permutations[chars]];
DictionaryLookup[Alternatives@@words]
]

Timing[Anagrams2["alerts"]]

Anagrams3[word_String]:=Module[{len=StringLength[word],words},
words=DictionaryLookup[RegularExpression["\\w{"<>ToString[len]<>"}"]];
Select[words,Sort[Characters[#]]==Sort[Characters[word]]&]
]

Timing[Anagrams3["alerts"]]

HammingDistance1[lis1_,lis2_]:=
Count[MapThread[SameQ,{lis1,lis2}],False]

HammingDistance2[lis1_,lis2_]:=Total[BitXor[lis1,lis2]]

sig1=RandomInteger[1,{(10^6)}];
sig2=RandomInteger[1,{(10^6)}];

Timing[HammingDistance1[sig1,sig2]]

Timing[HammingDistance2[sig1,sig2]]

PointsetDiameter[pts_List]:=Max[Apply[EuclideanDistance,Subsets[pts,{2}],{1}]]

pts=RandomReal[1,{5000,2}];
PointsetDiameter[pts]//Timing

With[{n=(10^6)},
Select[Select[Range[n],SquareNumberQ],PalindromeQ]]//Timing

With[{n=(10^6)},
Select[Select[Range[n],PalindromeQ],SquareNumberQ]]//Timing

pts=RandomReal[{-1,1},{(10^6),2}];
4.Total[Apply[Boole[#1^2+ #2^2≤1]&,pts,{1}]]/Length[pts]//Timing

4.Total[Map[Boole[First[#]^2+ Last[#]^2≤1]&,pts]]/Length[pts]//Timing

SetAttributes[AverageTiming,HoldAll]

AverageTiming[expr_,trials_]:=Mean[Table[First[AbsoluteTiming[expr]],{trials}]]

mat=RandomReal[1,{1000,1000}];
AbsoluteTiming[Inverse[mat];]

AverageTiming[Inverse[mat],5]

AverageTiming[{
mat.mat,
Inverse[mat],
Det[mat]
},5]

AverageTiming[
mat.mat;
Inverse[mat];
Det[mat];,
5]

SetAttributes[AverageTiming,HoldAll]

AverageTiming[expr_,trials_]:=Module[{lis},
lis=Table[AbsoluteTiming[expr],{trials}];
{Mean[lis[[All,1]]],lis[[1,2]]}
]

AverageTiming[FactorInteger[50!+1],5]

TriangularNumber[n_]:=Total[Range[n]]

Table[TriangularNumber[i],{i,1,100}]

Timing[TriangularNumber[(10^7)]]

TriangularNumber2[n_]:=Fold[#1+#2&,0,Range[n]]

Timing[TriangularNumber2[(10^7)]]

TriangularNumber3[n_]:=Binomial[n+1,2]

Timing[TriangularNumber3[(10^7)]]

Anagrams1[word_String]:=Module[{chars=Characters[word],words},
words=Map[StringJoin,Permutations[chars]];
DictionaryLookup[x__/;MemberQ[words,x]]]

Anagrams2[word_String]:=Module[{chars=Characters[word],words},
words=Map[StringJoin,Permutations[chars]];
DictionaryLookup[Alternatives@@words]
]

Anagrams3[word_String]:=Module[{len=StringLength[word],words},
words=DictionaryLookup[RegularExpression["\\w{"<>ToString[len]<>"}"]];
Select[words,Sort[Characters[#]]==Sort[Characters[word]]&]
]

With[{chars=Characters["alerts"]},
Timing[words=Map[StringJoin,Permutations[chars]];
]]

Timing[DictionaryLookup[x__/;MemberQ[words,x]];
]

Timing[DictionaryLookup[Alternatives@@words];]

Timing[Anagrams3["alerts"];]

Length[DictionaryLookup[w__/;StringLength[w]==StringLength["alerts"]]]

Length[DictionaryLookup[]]

HammingDistance1[lis1_,lis2_]:=
Count[MapThread[SameQ,{lis1,lis2}],False]

HammingDistance2[lis1_,lis2_]:=Total[BitXor[lis1,lis2]]

sig1=RandomInteger[1,{(10^6)}];

sig2=RandomInteger[1,{(10^6)}];

res=MapThread[SameQ,{sig1,sig2}];//Timing

Count[res,False]//Timing

On["Packing"]

res=MapThread[SameQ,{sig1,sig2}];

Attributes[BitXor]

Attributes[MapThread]

Timing[temp=BitXor[sig1,sig2];]

Timing[Total[temp];]

Off["Packing"]

pts=RandomReal[1,{12,3}];

ℛ=ConvexHullMesh[pts]

MeshCoordinates[ℛ]

PointsetDiameterCH[pts_]:=Module[{ℛ},
ℛ=ConvexHullMesh[pts];
Max@Apply[EuclideanDistance,Subsets[MeshCoordinates[ℛ],{2}],{1}]
]

pts=RandomReal[1,{2500,3}];

PointsetDiameter[pts_List]:=Max[Apply[EuclideanDistance,Subsets[pts,{2}],{1}]]

Timing[PointsetDiameter[pts]]

Timing[PointsetDiameterCH[pts]]

Count[Range[(10^6)],p_?PalindromeQ]//Timing

Count[Range[(10^6)],p_?SquareNumberQ]//Timing

On["Packing"]

pts=RandomReal[{-1,1},{(10^6),2}];
4.Total[Boole[#1^2+ #2^2≤1]&@@@pts]/Length[pts]//Timing

pts=RandomReal[{-1,1},{(10^6),2}];
4.Total[Boole[First[#]^2+ Last[#]^2≤1]&/@pts]/Length[pts]//Timing

Off["Packing"];

signal=Table[Sin[t]+RandomReal[0.2],{t,-2π,2π,0.05}];

ma=MovingAverage[signal,{1,2,6,8,6,2,1}/8];
ListPlot[{signal,ma},Joined->{False,True},PlotStyle->{Automatic,Red}]

Mandelbrot[c_]:=Length[NestWhileList[#^2+c&,0,Abs[#]<2&,1,250]]

data=With[{n=100},Table[Mandelbrot[x+I y],{y,-1.3,1.3,(1/n)},{x,-2,0.6,(1/n)}]];

ArrayPlot[data,ColorFunction->"GreenPinkTones"]

signal=Table[Sin[t]+RandomReal[{-.25,.25}],{t,0,4Pi,0.025}];

ma8=MovingAverage[signal,{1,-2,6,8,6,2,1}/8];
ListLinePlot[{signal,ma8},PlotStyle->{Automatic,{Red,Thickness[.005]}}]

ma=MovingAverage[signal,{1,1,2,1,1}/6];

LowpassFilter[signal,.5,31];

kernel[n_?OddQ]:=Table[((Exp[-((k^2)/(n^2))])/(Sqrt[2 π])),{k,-Floor[(n/2)],Floor[(n/2)]}]

ListConvolve[kernel[17],signal];

ParallelTable[
ListLinePlot[{signal,comp},
ImageSize->Tiny,
PlotStyle->{Automatic,{Red,Thickness[.005]}}],
{comp,{
MovingAverage[signal,{1,-2,6,8,6,2,1}/8],
MovingAverage[signal,{1,1,2,1,1}/6],
LowpassFilter[signal,.5,31],
kernel[n_?OddQ]:=Table[((Exp[-((k^2)/(n^2))])/(Sqrt[2 π])),{k,-Floor[(n/2)],Floor[(n/2)]}];
ListConvolve[kernel[17]/6,signal]}}
]

PerfectSearch[n_]:=Module[{perfectQ},
perfectQ[k_]:=Total[Divisors[k]]==2k;Select[Range[n],perfectQ]]

PerfectSearch[(10^6)]//Timing

PerfectSearch2[n_]:=Module[{perfectQ},
perfectQ[k_]:=DivisorSigma[1,k]==2k;Select[Range[n],perfectQ]]

PerfectSearch2[(10^6)]//Timing

PerfectSearch3[n_]:=Select[Range[2,n,2],(DivisorSigma[1,#]==2#&)]

PerfectSearch3[(10^6)]//Timing

PerfectSearchParallel[n_]:=
Parallelize[Select[Range[2,n,2],(DivisorSigma[1,#]==2#&)]]

PerfectSearchParallel[(10^6)]//Timing

primes=Parallelize[Select[Range[10000],PrimeQ[(2^(#))-1]&]]

perfectLis=Map[(2^(#-1))((2^(#))-1)&,primes];

perfectQ[j_]:=Total[Divisors[j]]==2 j;

Map[perfectQ,perfectLis]

(2^(#-1))((2^(#))-1)&[9941]//N

CloseKernels[]

joyce=Import["http://www.gutenberg.org/ebooks/4300.txt.utf-8","Text"];

hesse=Import["http://www.gutenberg.org/ebooks/2500.txt.utf-8","Text"];

bronte=Import["http://www.gutenberg.org/ebooks/768.txt.utf-8","Text"];

woolf=Import["http://www.gutenberg.org/ebooks/5670.txt.utf-8","Text"];

StringCount[joyce,"history"|"History"]

LaunchKernels[];

ParallelTable[StringCount[text,"history"|"History"],{text,{joyce,hesse,bronte,woolf}}]

CloseKernels[];

PiApprox[trials_]:=Module[{in=0,pt,pi,error},
pt:=RandomReal[1,{2}];
Do[If[Total[(pt^2)]≤1,in++],{trials}];
pi=N[4in/trials];
error=Abs[π-pi];
{pi,error}]

TableForm[Table[Join[{(10^i)},PiApprox[(10^i)]],{i,1,6}],TableHeadings->{None,{"Trials","π approx","Error"}}]

RegionDimension@Circle[{0,0},1]

RegionDimension@Disk[{0,0},1]

𝒟=Disk[{.5,.5},.5];
𝒫=Polygon[{{0,0},{1,0},{1,1},{0,1},{0,0}}];

pts=RandomReal[{0,1},{(10^4),2}];
in=Select[pts,RegionMember[𝒟,#]&];
out=Complement[pts,in];
4N[Length[in]/Length[pts],20]

Graphics[{
{Opacity[.25],EdgeForm[{Thickness[.01],Gray}],𝒟,𝒫},
PointSize[Tiny],Red,Point[in],Blue,Point[out]
},Axes->True,ImageSize->Small]

Timing[PiApprox[(10^4)]]

PiMonteCarlo[n_,prec_:$MachinePrecision]:=Module[{𝒟,𝒫,pts,in},
𝒟=Disk[{.5,.5},.5];
𝒫=Polygon[{{0,0},{1,0},{1,1},{0,1},{0,0}}];
pts=RandomReal[{0,1},{n,2}];
in=Select[pts,RegionMember[𝒟,#]&];
4N[Length[in]/Length[pts],prec]
]

Timing[PiMonteCarlo[(10^4)]]

PiMonteCarlo2[n_,prec_:$MachinePrecision]:=Module[{𝒟,𝒫,pts,in,rm,pi},
𝒟=Disk[{.5,.5},.5];
𝒫=Polygon[{{0,0},{1,0},{1,1},{0,1},{0,0}}];
pts=RandomReal[{0,1},{n,2}];
rm=RegionMember[𝒟];
in=Select[pts,rm[#]&];
pi=4N[Length[in]/Length[pts],prec];
{pi,Abs[π-pi]}
]

LaunchKernels[];

DistributeDefinitions[PiMonteCarlo2]

ParallelTable[PiMonteCarlo2[(10^6)],{24}]

Mean[%]

CloseKernels[];

Mandelbrot[c_]:=Length[NestWhileList[#^2+c&,0,Abs[#]<2&,1,250]]

LaunchKernels[]

DistributeDefinitions[Mandelbrot]

data=With[{n=400},ParallelTable[Mandelbrot[x+I y],{y,-1.3,1.3,(1/n)},{x,-2,0.6,(1/n)}]];

ArrayPlot[data,ColorFunction->"CMYKColors"]

CloseKernels[];

PadeApproximant[Log[1+x],{x,0,3}]

pt=RandomReal[1,{2}]

distReal=Compile[{{p,_Real}},Sqrt[((First[p])^2)+((Last[p])^2)],RuntimeAttributes->{Listable},Parallelization->True]

ArrayDepth[pt]

distReal=Compile[{{p,_Real,1}},Sqrt[((First[p])^2)+((Last[p])^2)],RuntimeAttributes->{Listable},Parallelization->True]

distReal[pt]

Norm[pt]

pts=RandomReal[1,{3,2}]

distReal[pts]

Map[Norm,pts]

distReal[pts]==Map[Norm,pts]

pts=RandomReal[1,{(10^6),2}];

AbsoluteTiming[distReal[pts];]

AbsoluteTiming[Map[Norm,pts];]

distReal[pts]==Map[Norm,pts]

distReal=Compile[{{p,_Real,1}},Sqrt[((First[p])^2)+((Last[p])^2)],RuntimeAttributes->{Listable},Parallelization->True,CompilationTarget->"C"]

distReal2=Compile[{{p,_Real,1}},Sqrt[((p[[1]])^2)+((p[[2]])^2)],RuntimeAttributes->{Listable},Parallelization->True,CompilationTarget->"C"]

AbsoluteTiming[distReal2[pts];]

NIntegrate[(Sqrt[(x^2)+(y^2)]),{x,0,1},{y,0,1}]

Mean@distReal[pts]

distComplex=Compile[{{z,_Complex}},Sqrt[((Re[z])^2)+((Im[z])^2)],RuntimeAttributes->{Listable},Parallelization->True]

pts=RandomComplex[1,{3}]

distComplex[pts]

distComplex[pts]==Map[Norm,pts]

PadeApproximant[Log[1+x],{x,0,3}]

logC = Compile[{{x, _Real}},((x+(x^2)+((11 (x^3))/60))/(1+((3 x)/2)+((3 (x^2))/5)+((x^3)/20)))]

DiscretePlot[Log[1+x]-logC[x],{x,0,2,.1},PlotRange->All]

logC=Compile[{{x,_Real}},Evaluate[PadeApproximant[Log[1+x],{x,0,5}]]]

DiscretePlot[Log[1+x]-logC[x],{x,0,2,.1},PlotRange->All]

cJulia2=Compile[{{z,_Complex},{c,_Complex}},Module[{cnt=1},
FixedPoint[(cnt++;c Sin[#])&,z,100,SameTest->(Abs[Im[#2]]>50&)];cnt], CompilationTarget->"C",RuntimeAttributes->{Listable},Parallelization->True,"RuntimeOptions"->"Speed"]

LaunchKernels[]

With[{res=100},ArrayPlot[ParallelTable[-cJulia2[x+y I,1+0.4I],{y,-2π,2π,(1/res)},{x,-2π,2π,(1/res)}],ColorFunction->ColorData["CMYKColors"]]]

CloseKernels[];

CollatzSequence[7]

Quit[];

<<EPM`Collatz`

?CollatzSequence

CollatzSequence[-5]

CollatzSequence[{a,b}]

CollatzSequence[27]

collatz[n_?EvenQ]:=n/2

collatz[n_?OddQ]:=3n+1

CollatzSequence[n_]:=NestWhileList[collatz,n,#≠1&]

CollatzSequence[7]

CollatzSequence::usage="CollatzSequence[n] computes the sequence of Collatz iterates starting with initial value n. The sequence terminates as soon as it reaches the value 1.";

CollatzSequence::notint="First argument, `1`, to CollatzSequence must be a positive integer.";

CollatzSequence[n_]:=If[IntegerQ[n]&&n≥0,NestWhileList[collatz,n,#≠1&],Message[CollatzSequence::notint,n]]

CollatzSequence[_,args__]/;Message[CollatzSequence::argx,CollatzSequence,Length[{args}]+1]:=Null

Quit[]

BeginPackage["EPM`Collatz`"];

CollatzSequence::usage="CollatzSequence[n] computes the sequence of Collatz iterates starting with initial value n. The sequence terminates as soon as it reaches the value 1.";

CollatzSequence::notint="First argument, `1`, to CollatzSequence must be a positive integer.";

Begin["`Private`"];

collatz[n_?EvenQ]:=n/2

collatz[n_?OddQ]:=3n+1

CollatzSequence[n_]:=If[IntegerQ[n]&&n≥0,NestWhileList[collatz,n,#≠1&],Message[CollatzSequence::notint,n]]

CollatzSequence[_,args__]/;Message[CollatzSequence::argx,CollatzSequence,Length[{args}]+1]:=Null

End[];

EndPackage[]

BeginPackage["EPM`StemPlots`"]

StemPlot::usage="StemPlot[data] returns a stem plot of the discrete data, data.";

StemPlot::badarg="The first argument to StemPlot must be a list of numbers.";

Options[StemPlot]=Options[ListPlot];

Begin["`Private`"]

StemPlot[lis_,opts:OptionsPattern[]]:=
If[MatchQ[lis,{__?NumericQ}],
ListPlot[lis,opts,Filling->Axis],
Message[StemPlot::badarg]
]

End[]

EndPackage[]

<<EPM`StemPlots`

?StemPlot

data=RandomInteger[{-5,10},12];
StemPlot[data]

StemPlot[data,
PlotStyle->Directive[PointSize[Medium]],FillingStyle->Red
]