Stats

Popular Posts

Followers

這是留言板-既然來了,就留個言再走吧!

養花種魚數月亮賞星星 於 Monday, July 22, 2019 2:43 PM 發表


Please tell me what you thought about this blog. Comments, suggestions and views are welcomed.
繼續閱讀全文 這是留言板-既然來了,就留個言再走吧!

Mathematica 教學:Just for Fun

Chung-Yuan Dye 於 Saturday, August 30, 2014 5:51 PM 發表
http://www.ptt.cc/bbs/Mathematica/M.1408824011.A.055.html

Q: 5X5方格中放置1~25的數字,數字是隨機放置,移動的路徑長度的平均數與變異數為何?。

Clear["Global`*"];
DynamicModule[{i,temp,dist,newdata},
dist[data_]:=
N@Total[EuclideanDistance@@@
Partition[Flatten[Position[data,#]&/@Range[25],1],2,1]];
temp={};i=0;
Dynamic[{i=i+1;
newdata:=Partition[RandomSample[Range[25],25],5];
temp=Join[temp,{dist[newdata]}]};
Column[{MatrixForm[newdata],
Grid[{{"Distance=",dist[newdata]}}],
Histogram[temp,{25,100,1},"PDF",Frame->True,Axes->None,
PlotRange->{{40,100},{0,0.2}},ImageSize->400,
Epilog->Inset[
Grid[{
{"Samplesize=",Length@temp},
{"\[Mu]=",NumberForm[N@Mean@temp,{7,4}]},
{"\[Sigma]=",NumberForm[N@StandardDeviation@temp,{5,4}]},
{"Shapiro\[Dash]Wilktest",NumberForm[ShapiroWilkTest[temp],{5,4}]}},
Frame->True,Alignment->{{Right,Left}}],{85,0.15}]]}]]]
繼續閱讀全文 Mathematica 教學:Just for Fun

Mathematica 教學:Make a FrameLabel for a GridGraphics object

Chung-Yuan Dye 於 Thursday, August 14, 2014 10:40 AM 發表


Labeled[
GraphicsGrid[Table[Plot[Sin[a*x]*Cos[b*x],{x,0,2Pi},
PlotRange->{{0,2Pi},{-1,1}}],{a,3},{b,3}]],
{"This is title 1","This is title 2"},{Top,Bottom}]
繼續閱讀全文 Mathematica 教學:Make a FrameLabel for a GridGraphics object

Mathematica 教學:級數係數

Chung-Yuan Dye 於 Tuesday, August 12, 2014 2:29 PM 發表





Unprotect[Power];0^0:=1;Protect[Power];
f=(p0*z)^k(1-p0*z)(1-p0*z-q0*z*(1-(p0*z)^k))^(-1);
D[f,{z,1}]/.k->1/.z->0
D[f,{z,2}]/2/.k->1/.z->0//Simplify
D[f,{z,3}]/6/.k->1/.z->0//Simplify
D[f,{z,4}]/24/.k->1/.z->0//Simplify
test1=Table[(D[f,{z,n}]/n!/.k->1/.z->0),{n,1,10}]//Simplify
SeriesCoefficient[f/.k->1,{z,0,n}]
test2=SeriesCoefficient[f/.k->1,{z,0,#}]&/@Range[10]//Simplify
test1===test2

mytable[{kl_,ku_},{nl_,nu_}]:=
TableForm[Table[SeriesCoefficient[f/.k->kk,{z,0,nn}],
{kk,kl,ku},{nn,nl,nu}],
TableHeadings->{Range[kl,ku],"第"<>ToString[#]<>"項"&/@Range[nl,nu]}]

mytable[{11,20},{8,15}]
繼續閱讀全文 Mathematica 教學:級數係數

Mathematica 教學:Central Limit Theorem 2

Chung-Yuan Dye 於 Friday, July 25, 2014 7:59 PM 發表




Grid[{{Module[{x,xx,z,temp1,size1},
x={};temp1=1;size1=10;
xx:={(Mean[RandomReal[GammaDistribution[10,2],size1]]-20)*Sqrt[size1]/Sqrt[40]};
Dynamic[Column[{size1,
Histogram[temp1=temp1+1;
If[temp1<=300,x=Join[x,xx],size1=size1+1;temp1=1;x=xx],{-4,4,0.4},"PDF",
Frame->True,Axes->None,PlotRange->{{-4,4},{0,1}},
Epilog->First@Plot[PDF[NormalDistribution[0,1],z],{z,-4,4},PlotStyle->Red]]},
Center]]],

Module[{y,yy,temp2,size2},
y={};temp2=1;size2=10;
yy:={(Mean[RandomVariate[BinomialDistribution[10,0.2],size2]]-2)*
Sqrt[size2]/Sqrt[1.6]};
Dynamic[Column[{size2,
Histogram[temp2=temp2+1;
If[temp2<=300,y=Join[y,yy],size2=size2+1;temp2=1;y=yy],{-4,4,0.4},"PDF",
Frame->True,Axes->None,PlotRange->{{-4,4},{0,1}},
Epilog->First@Plot[PDF[NormalDistribution[0,1],z],{z,-4,4},PlotStyle->Red]]},
Center]]]}}]
繼續閱讀全文 Mathematica 教學:Central Limit Theorem 2

Mathematica 教學:Central Limit Theorem

Chung-Yuan Dye 於 Thursday, July 24, 2014 11:22 AM 發表



Clear["Global`*"];
SetOptions[Plot,{Frame->True,Axes->None,PlotStyle->Red}];
SetOptions[Histogram,{Frame->True,Axes->None,ImageSize->350}];

mySumStdDist[dist_,parameters__,size_,repeat_,scale_]:=
Block[{x,y,domain,mydist,mysumdist,mypdf,normaldist,mu,sigma,
range,data1,data2,data3,data4,data1std,hist1,hist2,hist3,
hist4,normalplot,normalstdplot,histscale},
mydist=Apply[dist,parameters];

mysumdist=TransformedDistribution[Total[y[#]&/@Range[size]],
(y[#]\[Distributed]mydist)&/@Range[size]];

mu=Mean[mysumdist];
sigma=StandardDeviation[mysumdist];
domain=DistributionDomain[mysumdist];
range=If[Head[domain]===Interval,domain[[1]],domain];
range={Max[range[[1]],mu-3sigma],Min[range[[-1]],mu+3sigma]};

data1=RandomVariate[mysumdist,size];
data1std=Standardize@data1;
data2=RandomVariate[mydist,{repeat,size}];
data3=Total/@data2;
data4=Standardize[Mean/@data2];

(*直方圖*)

hist1=Histogram[data1,{Min[data1],Max[data1],
(Max[data1]-Min[data1])/20.},"PDF"];

hist2=Histogram[data1std,{Min[data1std],Max[data1std],
(Max[data1std]-Min[data1std])/20.},"PDF"];

hist3=Histogram[data3,{Min[data3],Max[data3],
(Max[data3]-Min[data3])/20.},"PDF"];

hist4=Histogram[data4,{Min[data4],Max[data4],
(Max[data4]-Min[data4])/20.},"PDF"];

normalplot=Plot[PDF[NormalDistribution[mu,sigma],x],{x,Min[data1],Max[data1]}];

normalstdplot=Plot[PDF[NormalDistribution[0,1],x],{x,-4,4}];

(*避免直方圖機率小於設定scale*)

histscale=Max[scale,Max[Cases[#,RectangleBox[a__,b__,___]:>b[[-1]],
Infinity]]]&/@{hist1,hist2,hist3,hist4};

(*圖形輸出*)

GraphicsGrid[
{{
Show[hist1,normalplot,
PlotRange->{0,histscale[[1]]},
PlotLabel->PlotLabel->"The distribution of Sum Xi"],

Show[hist2,normalstdplot,
PlotRange->{0,histscale[[2]]},
PlotLabel->"The distribution of Standardize Sum Xi"]},

{Show[hist3,normalplot,
PlotRange->{0,histscale[[3]]},
PlotLabel->"The central limit theorem for Sum Xi"],

Show[hist4,normalstdplot,
PlotRange->{0,histscale[[4]]},
PlotLabel->"The central limit theorem for Standardize sample mean"]
}},ImageSize->700]
];


Manipulate[
mySumStdDist[BinomialDistribution,{n,p},size,repeat,scale],
{{n,10},10,100,1,Appearance->"Labeled"},
{{p,0.2},0.1,0.9,0.1,Appearance->"Labeled"},
{{size,100},30,1000,1,Appearance->"Labeled"},
{{repeat,100},10,1000,1,Appearance->"Labeled"},
{{scale,0.5},0.01,1,0.01,Appearance->"Labeled"}
]

Manipulate[
mySumStdDist[GammaDistribution,{a,b},size,repeat,scale],
{{a,10},1,100,1,Appearance->"Labeled"},
{{b,0.5},0.1,1.5,0.1,Appearance->"Labeled"},
{{size,100},30,1000,1,Appearance->"Labeled"},
{{repeat,100},10,1000,1,Appearance->"Labeled"},
{{scale,0.5},0.01,1,0.01,Appearance->"Labeled"}
]
繼續閱讀全文 Mathematica 教學:Central Limit Theorem

Finally, the first acceptance of 2014 comes.

Chung-Yuan Dye 於 Sunday, June 29, 2014 8:13 AM 發表



Chung-Yuan Dye, Chih-Te Yang, Fang-Cheng Kung

Abstract

In 2014, Wang et al. (2014) extended the model of Lou and Wang (2012) to incorporate the credit period dependent demand and default risk for deteriorating items with maximum lifetime. However, the rates of demand, default risk and deterioration in the model of Wang et al. (2014) are assumed to be specific functions of credit period which limits the contributions. In this note, we first generalize the theoretical results of Wang et al. (2014) under some certain conditions. Furthermore, we also present some structural results instead of a numerical analysis on variation of optimal replenishment and trade credit strategies with respect to key parameters.

Keywords: Supply chain management; Inventory; Maximum lifetime; Trade credit
繼續閱讀全文 Finally, the first acceptance of 2014 comes.

Excel 教學 用函數抓每行最後一筆資料

Chung-Yuan Dye 於 Friday, February 7, 2014 12:00 PM 發表



繼續閱讀全文 Excel 教學 用函數抓每行最後一筆資料

Mathematica 教學 統計檢定表格

Chung-Yuan Dye 於 Monday, January 27, 2014 6:17 PM 發表


表格多的時候,這倒是個好方法~~

myTTest1[data_]:=Flatten@{ToString[NumberForm[Mean@data[[All,2]],{4,3}]]<>
"\[PlusMinus]"<>ToString[NumberForm[StandardDeviation@data[[All,2]],{4,3}]],
ToString[NumberForm[Mean@data[[All,3]],{4,3}]]<>"\[PlusMinus]"<>
ToString[NumberForm[StandardDeviation@data[[All,3]],{4,3}]],
If[Abs[#]>0.00002,NumberForm[#,{4,3}],"0.000"]&/@TTest[{data[[All,2]],
data[[All,3]]},0,{"TestStatistic","PValue"},VerifyTestAssumptions->"EqualVariance"]};

myTTest2[data_]:=Flatten@{ToString[NumberForm[Mean@data[[1,All,2]],{4,3}]]
<>"\[PlusMinus]"<>ToString[NumberForm[StandardDeviation@data[[1,All,2]],{4,3}]],
ToString[NumberForm[Mean@data[[2,All,2]],{4,3}]]<>"\[PlusMinus]"
<>ToString[NumberForm[StandardDeviation@data[[2,All,2]],{4,3}]],
If[Abs[#]>0.00002,NumberForm[#,{4,3}],"0.000"]&/@TTest[{data[[1,All,2]],
data[[2,All,2]]},0,{"TestStatistic","PValue"},VerifyTestAssumptions->"EqualVariance"]}


mydata1[data_,cond1_,cond2_]:=Block[{height,weight,bmi,x1,x2,x3,x4},
height=Select[data,#[[3]]==cond1&&#[[1]]==cond2&][[All,{1,5,8}]];
weight=Select[data,#[[3]]==cond1&&#[[1]]==cond2&][[All,{1,6,9}]];
bmi=Select[data,#[[3]]==cond1&&#[[1]]==cond2&][[All,{1,7,10}]];
x1=Heigt=Select[data,#[[3]]==cond1&&#[[1]]==cond2&][[All,{1,11,15}]];
x2=Heigt=Select[data,#[[3]]==cond1&&#[[1]]==cond2&][[All,{1,12,16}]];
x3=Heigt=Select[data,#[[3]]==cond1&&#[[1]]==cond2&][[All,{1,13,17}]];
x4=Heigt=Select[data,#[[3]]==cond1&&#[[1]]==cond2&][[All,{1,14,18}]];
{height,weight,bmi,x1,x2,x3,x4}
]

mydata2[data_,cond2_]:=Block[{height,weight,bmi,x1,x2,x3,x4},
height=Select[data,#[[1]]==cond2&][[All,{3,8}]];
weight=Select[data,#[[1]]==cond2&][[All,{3,9}]];
bmi=Select[data,#[[1]]==cond2&][[All,{3,10}]];
x1=Select[data,#[[1]]==cond2&][[All,{3,15}]];
x2=Select[data,#[[1]]==cond2&][[All,{3,16}]];
x3=Select[data,#[[1]]==cond2&][[All,{3,17}]];
x4=Select[data,#[[1]]==cond2&][[All,{3,18}]];
SplitBy[#,(#[[1]])&]&/@{height,weight,bmi,x1,x2,x3,x4}
]

mylabel1={{"身高","體重","BMI","姿體前彎","立定跳遠","仰臥起坐","心肺適能"},
{"前測","前測","T 值","P-Value"}};
mylabel2={{"身高","體重","BMI","姿體前彎","立定跳遠","仰臥起坐","心肺適能"},
{"男生","女生","T 值","P-Value"}};

TableForm[myTTest1/@mydata1[data,"男","實驗組"],
TableHeadings->mylabel1]

TableForm[myTTest1/@mydata1[data,"女","實驗組"],
TableHeadings->mylabel1]

TableForm[myTTest1/@mydata1[data,"男","對照組"],
TableHeadings->mylabel1]

TableForm[myTTest1/@mydata1[data,"女","對照組"],
TableHeadings->mylabel1]

TableForm[myTTest2/@mydata2[data,"實驗組"],TableHeadings->mylabel2]

TableForm[myTTest2/@mydata2[data,"對照組"],TableHeadings->mylabel2]


繼續閱讀全文 Mathematica 教學 統計檢定表格

Mathematica 教學 多項式公因式分解

Chung-Yuan Dye 於 Thursday, January 16, 2014 6:21 PM 發表
http://www.ptt.cc/bbs/Mathematica/M.1389794909.A.0ED.html



common[exp_List]:=Block[{factor,tempexp,gcd},
(* 判斷是否為乘法,是的話因式分解;不是的話,加係數1在做因式分解 *)
(* 最後將乘法改成陣列 *)
tempexp=If[SameQ[Head@#,Times],Factor[#],
{1,Factor[#]}]&/@exp/.Times->List;
tempexp=Flatten/@tempexp;
(* 公因式 *)
factor=Intersection@@tempexp;
(* 係數的公因數 *)
gcd=GCD@@tempexp[[All,1]];
(* 輸出 *)
{Times@@factor*gcd,Times@@#/Times@@factor/gcd&/@tempexp}
]

繼續閱讀全文 Mathematica 教學 多項式公因式分解

Mathematica 教學 問卷項目分析

Chung-Yuan Dye 於 Tuesday, December 31, 2013 12:30 AM 發表



ItemAnalysis[data_]:=
Block[{varname=data[[1]],mydata=data[[2;;-1]],sum,lower,
upper,testdata,testdatalow,testdatahigh,itemdata},
sum=Flatten@{#,Total[#]}&/@mydata;
lower=Quantile[sum[[All,-1]],0.25];
upper=Quantile[sum[[All,-1]],0.75];
testdata={sum[[#]],
If[sum[[#,-1]]>=upper,2,
If[sum[[#,-1]]<=lower,1,0]]}&/@Range[Length@sum];
testdata=GatherBy[testdata,Last];
testdatalow=Cases[testdata,{a_,1},Infinity][[All,1]];
testdatahigh=Cases[testdata,{a_,2},Infinity][[All,1]];
itemdata={Flatten@{varname[[#]],"低分組",
Length@testdatalow[[All,#]],
NumberForm[N@Mean@testdatalow[[All,#]],{5,4}],
NumberForm[N@StandardDeviation@testdatalow[[All,#]],{5,4}],
{NumberForm[#[[1]],{5,4}],NumberForm[If[#[[2]]<0.00001,0,#[[2]]],{5,4}]}&/@
{TTest[{testdatalow[[All,#]],testdatahigh[[All,#]]},0,"TestDataTable",
VerifyTestAssumptions->"EqualVariance"][[1,1,
2,{2,3}]]}},{"","高分組",Length@testdatahigh[[All,#]],
NumberForm[N@Mean@testdatahigh[[All,#]],{5,4}],
NumberForm[N@StandardDeviation@testdatahigh[[All,#]],{5,4}],
"",""}}&/@Range[Length@varname];
TableForm[Flatten[itemdata,1],
TableHeadings->{None,{"題項","組別","個數","平均數","標準差","T值","P-Vale"}}]]

(*用法*)
(*資料的第一列為變數名稱*)
ItemAnalysis[你的資料]
繼續閱讀全文 Mathematica 教學 問卷項目分析

Mathematica 教學 Fun with SocialMediaData

Chung-Yuan Dye 於 Thursday, December 26, 2013 12:00 AM 發表


test=SocialMediaData["Facebook","FriendNetwork"]
test1=ToExpression[StringReplace[ToString@FullForm@test,"Graph["->"graph["]];
icondata={#[[1]],#[[2,1,2]],Import[#[[2,2,2]]]}&/@test1[[3,4,2]];
Graph@@(test1/.{test1[[3,-3,2]]->Apply[Rule,{#[[1]],
Placed[Image[#[[-1]],ImageSize->{30}],Center]}&/@icondata,{1}],test1[[3,-2,2]]->Tiny})

繼續閱讀全文 Mathematica 教學 Fun with SocialMediaData

Mathematica 教學 行取最大值後,那一行列不再考慮

Chung-Yuan Dye 於 Thursday, December 12, 2013 10:44 AM 發表
 作者  goldberg73 (高柏)                                         看板  MATLAB  標題  [討論]行取最大值後,那一行列不再考慮?由左而右  時間  Thu Dec 12 09:28:12 2013 ───────────────────────────────────────  假設有一A矩陣 4*4 A=[15 20 17 27; 14 78 41 21 ; 32 14 12 14 ; 14 25 25 24]   15 20 17 27 14 78 41 21 32 14 12 14 14 25 25 24  想要每一行取最大值,從第一行開始, 且出現最大值的那一列, 往後不予考慮 參與第二行取最大值... 由此類推  結果為:  32     (第一行的最大值為32 , 因此第二行取最大值,不考慮第三列) 78     (第二行的最大值是78,  因此第三行取最大值 不考慮第三列 和第二列) 25     (第三行的最大值是25 , 因此第四行取最大值不考慮第四列 第三列和第二列) 27     (不考慮 第二 三 四列下, 第四行的值為27)
myfun[data_]:=Block[{temp,tempdata=data,i},
temp[i_]:=Block[{x},
x=Position[tempdata[[All,i]],Max@tempdata[[All,i]]][[1,1]];
Set[tempdata[[x,i+1;;-1]],Table[-Infinity,{Length@tempdata-i}]];
tempdata];
Do[tempdata=temp[i],{i,Length@tempdata-1}];
Max[tempdata[[All,#]]]&/@Range[Length@tempdata]];

A={{15,20,17,27},{14,78,41,21},{32,14,12,14},{14,25,25,24}};
myfun[A]
繼續閱讀全文 Mathematica 教學 行取最大值後,那一行列不再考慮

Mathematica 教學 資料依指定區間分組

Chung-Yuan Dye 於 Tuesday, December 10, 2013 6:16 PM 發表

 作者  celestialgod (攸藍)                                       看板  MATLAB  標題  [運算] 給定區間分組  時間  Tue Dec 10 15:59:41 2013 ───────────────────────────────────────  data = randn(3670000,1);  我有一個區間是  -3 -2 -1 0 1 2 3  我想要把資料中小於-3分為第一組,界在-3跟-2之間分為第二組,剩下依此類推


data=RandomReal[{-5,7},100];
group=Partition[{-5,-4,-1,2,4,6,7},2,1];
myInterval[mynum_]:=Position[IntervalMemberQ[Interval[#],mynum]&/@group,True][[1,1]];
Gather[Sort@data,myInterval[#1]==myInterval[#2]&]
GatherBy[Sort@data,myInterval[#]&]

繼續閱讀全文 Mathematica 教學 資料依指定區間分組

Word 論文排版

Chung-Yuan Dye 於 Thursday, December 5, 2013 9:13 AM 發表

PowerCam Word排版教學

IE Only,需允許安裝POwerCam附屬程式。

介紹MS Word論文排版,檔案內容如下:
  1. 大綱模式
  2. 多階層清單
  3. 目錄製作
  4. 表目錄製作
  5. 圖目錄製作

繼續閱讀全文 Word 論文排版

Mathematica 教學 微積分的運用

Chung-Yuan Dye 於 Saturday, November 30, 2013 9:20 PM 發表




Mathematica在最佳化理論上的應用





















































繼續閱讀全文 Mathematica 教學 微積分的運用