理論力學(xué)輔助：

Lf[tt_, vv_, var__, t_] := 
 Module[{l = Simplify[tt - vv], n = Length[var], i = 0},
  Table[D[D[l, D[var[[i]], t]], t] - D[l, var[[i]]], {i, 1, n}]
  ]

例子：

In[1]:= Lf[1/2 m x1'[t]^2 + 1/2 m x2'[t]^2, 
 1/2 k (x1[t]^2 + x2[t]^2), {x1[t], x2[t]}, t]

Out[1]= {k x1[t] + m (x1^\[Prime]\[Prime])[t], 
 k x2[t] + m (x2^\[Prime]\[Prime])[t]}

大物實驗助手：

處理數(shù)據(jù)：

FixData[list_List, f_Function] := 
 Module[{l = Length[list]}, Table[f[list[[i]]], {i, 1, l}]]

離散函數(shù)頻譜分析：

注：正在完善之中

FuL[l_List, \[Omega]_, \[Delta]t_, {a_, b_}] := 
 1/Abs[b - a] Total@
   Table[l[[i]] \[Delta]t E^(I \[Omega] i \[Delta]t), {i, 1, 
     Length[l]}]

(*使用示例*)
ls = Table[Evaluate[x[t] /. s], {t, 0, 200, 0.1}];(*s是一個混沌方程的解*)

PL = Flatten@
   Table[FuL[ls, \[Omega], 0.1, {0, 200}], {\[Omega], 0.1, 4, 0.002}];

頻譜圖

復(fù)變函數(shù)繪圖好幫手：

TransComplexPlot[w_, f_, {x_, xf_, xz_}, {y_, yf_, yz_}, 
  PlotPoints -> n_, PlotRange -> {{l_, r_}, {d_, u_}}] :=
 ParametricPlot[{Re[w[f]], Im[w[f]]}, {x, xf, xz}, {y, yf, yz}, 
  PlotPoints -> n, PlotRange -> {{l, r}, {d, u}}]

使用示例：

使用示例

波動光學(xué)繪圖

Len = Compile[{{x, _Real}, {y, _Real}, {z, _Real}, {x2, _Real}, {y2, \
_Real}, {z2, _Real}}, 
  If[{x, y, z} != {x2, y2, z2}, Sqrt[
   N[(x - x2)^2 + (y - y2)^2 + (z - z2)^2]], 1.0]]

PutDot = Compile[{{x, _Real}, {y, _Real}, {z, _Real}, {\[CurlyPhi], \
_Real}, {\[Omega], _Real}, {W, _Real}, {b, _Real}, {L, _Integer}},
  Table[N[
    W/(b*Len[x, y, z, i, j, 0])*
     E^(-I (\[Omega] b*Len[x, y, z, i, j, 0] + \[CurlyPhi]))], {i, 1, 
    L}, {j, 1, L}]
  ]

LightDotQ[n_, \[Omega]_, b_, DList_] := Module[
  {x = Length[DList], LightPx = Table[0, {i, 1, n}, {j, 1, n}]},
  LightPx = 
   Abs[Sum[PutDot[DList[[k]][[1]], DList[[k]][[2]], 0, 
      DList[[k]][[3]], \[Omega], DList[[k]][[4]], b, n], {k, 1, x}]];
  ArrayPlot[LightPx, ColorFunction -> "Rainbow"]
  ]

LightDot3DQ[n_, \[Omega]_, b_, DList_, z_] :=
 Module[
  {x = Length[DList], LightPx = Table[0, {i, 1, n}, {j, 1, n}]},
  LightPx = 
   Abs[Sum[PutDot[DList[[k]][[1]], DList[[k]][[2]], z, 
      DList[[k]][[3]], \[Omega], DList[[k]][[4]], b, n], {k, 1, x}]];
  ArrayPlot[LightPx, ColorFunction -> "Rainbow"]
  ]

使用示例：

模擬平面上的有源相控陣光場

模擬三維空間中的光場

使用說明：

遺傳算法程序包（不完整）

1.建立種群：

MakeGroup[Num_Integer, f_Function] := Table[f[i], {i, 1, Num}]

示例：

In[1]  = MakeGroup[10, Sin[#/2] &]

Out[1] = {Sin[1/2], Sin[1], Sin[3/2], Sin[2], Sin[5/2], Sin[3], Sin[7/2], 
 Sin[4], Sin[9/2], Sin[5]}

2.基因交換

基礎(chǔ)模式：

Swap[List1_List, List2_List, {S_Integer, T_Integer}] :=
 (*基因一，基因二，｛開始交換點藻治，終止交換點｝*)
 Block[
  {Len = Length[List1], Len2 = Length[List2]},
  If[Len != Len2, Null,(*若長度不等，返回Null*)
   (*Table[If[S\[LessEqual]i\[LessEqual]T,
   List2\[LeftDoubleBracket]i\[RightDoubleBracket],
   List1\[LeftDoubleBracket]i\[RightDoubleBracket]],{i,1,Len}]交換*)
   List1[[1 ;; S - 1]]~Join~List2[[S ;; T]]~Join~List1[[T + 1 ;; Len]]
   ]
  ]

基因突變：

Changex[GeList_List, Pc_Integer, {f_Function, Kind_String}] := Block[
  {GeCopy = GeList},
  Switch[(*考慮多種變化選項*)
   Kind,
   "Change", GeCopy[[Pc]] = f[GeCopy[[Pc]]],
   "Add", GeCopy[[Pc]] += f[GeCopy[[Pc]]]]; GeCopy
  ]

GeChange[p_Real, GeList_List, n_Integer, {f_Function, Kind_String}] :=
 (*突變概率截驮，基因序列藏斩，突變n次，｛突變函數(shù)劫狠，突變模式｝*)
 Block[
  {Len = Length[GeList],
   Pc = 0,
   GeCopy = 0
   },
  If[RandomReal[] < p,
   GeCopy = GeList;
   Nest[Changex[#, RandomInteger[{1, Len}], {f, Kind}] &, GeCopy, n](*n次迭代*)
   , GeList]
  ]

GeChangeList[GeList_List, pList_List, {f_Function, Kind_String}] :=
 (*基因序列，突變序列永部，｛突變函數(shù)独泞，突變模式｝*)
 Block[
  {Len = Length[GeList],
   Pc = 0,
   GeCopy = GeList
   },
  Do[GeCopy = Changex[GeCopy, pList[[i]], {f, Kind}];, {i, 1, Length[pList]}];
  GeCopy
  ]

GePMC[GeList_List, {S_Integer, T_Integer}] :=(*部分重排序*)
 (*需要突變的基因，｛開始位苔埋，結(jié)束位｝*)
 Module[{GeCopy = GeList,
   head = GeList[[1 ;; S - 1]],
   body = GeList[[S ;; T]],
   foot = GeList[[T + 1 ;; Length[GeList]]]
   },
  head~Join~Reverse[body]~Join~foot
  ]

示例：

隨機變異一個基因：

隨機變異一個基因

基因倒位：

基因倒位

第二次更新于2014年11月20日