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.
繼續閱讀全文 這是留言板-既然來了,就留個言再走吧!

愛犬阿寶

Chung-Yuan Dye 於 Thursday, February 11, 2016 9:56 PM 發表




繼續閱讀全文 愛犬阿寶

Mathematica 教學:非線性規劃

Chung-Yuan Dye 於 9:23 PM 發表

繼續閱讀全文 Mathematica 教學:非線性規劃

Mathematica 教學:方程式求解

Chung-Yuan Dye 於 9:18 PM 發表

繼續閱讀全文 Mathematica 教學:方程式求解

愛犬阿寶

Chung-Yuan Dye 於 8:54 PM 發表



繼續閱讀全文 愛犬阿寶

Mathematica 教學:Generate relevant reports with LaTeX

Chung-Yuan Dye 於 Sunday, February 7, 2016 10:57 AM 發表
SetDirectory[NotebookDirectory[]]
(* Variable names *)
vars = Import["1042.tsv", CharacterEncoding -> "UTF8"][[1]];
(* data file *)
data = Import["1042.tsv", CharacterEncoding -> "UTF8"][[2 ;; -1]];
(* Split data file by department *)
mydata = GatherBy[data, #[[29]] &];
mydep[depnum_] := 
mydep[depnum_]:=Block[{mystr,mytex},mystr=#[[1]]<> " & " <>#[[2]]<>"\\\\ \\hline"&/@
(Partition["\\raisebox{-\\totalheight}{\\includegraphics[width=0.14\\textwidth]{"<> #[[3]] <>"}} & 
"<>"姓名 "<>#[[4]]<>"\\par 原讀學校系所\\par "<>#[[25]]<>"\\par "<>#[[26]]<>"\\par 籍貫 "<>#[[15]]<>
"\\par 生日 "<> #[[8]]<>"\\par 電話 "<>ToString@ #[[12]]&/@mydata[[depnum]],2]);
mytex=StringJoin[
(*LaTeX preamble and Longtable code *)
"\ \documentclass[11pt, a4paper]{article}
\\usepackage{CJKutf8} 
\\usepackage{geometry}
\\geometry{verbose,a4paper,tmargin=1.5in,bmargin=1.5in,lmargin=1in,rmargin=1in,footskip=1cm}
\\usepackage[pdftex]{graphicx} 
\\usepackage{longtable}
\\begin{document} 
\\begin{CJK}{UTF8}{cwmc}
\\tabcolsep=3pt  
\\begin{center}
\\begin{longtable}{|p{0.15\\textwidth}|p{0.3\\textwidth}|p{0.15\\textwidth}|p{0.3\\textwidth}|}\\hline",
(* LaTeX Report *)
mystr,
(* LaTeX code *)
" \\end{longtable}
\\end{center}
\\end{CJK}
\\end{document}"];
mytex=StringReplace[mytex,"\\raisebox{-\\totalheight}{\\includegraphics[width=0.14\\textwidth]{取消來台}}"->"取消來台"];
(* Generate TeX file*)
RenameFile[Export[mydata[[depnum,1,-4]]<>".txt",mytex],ToString@depnum<>".tex"];
(* Generate PDF file *)
Run["cd "<>NotebookDirectory[]<>"; /Library/TeX/texbin/pdflatex "<>ToString[depnum]];
RenameFile[ToString@depnum<>".pdf", mydata[[depnum,1,-4]]<>".pdf"];
(* Remove Relevant files *)
DeleteFile[ToString@depnum<>".aux"];
DeleteFile[ToString@depnum<>".tex"];
DeleteFile[ToString@depnum<>".log"];
]
繼續閱讀全文 Mathematica 教學:Generate relevant reports with LaTeX

陽光打到哪就睡到哪

Chung-Yuan Dye 於 Wednesday, January 27, 2016 8:58 PM 發表


相較前兩天,今天的確溫暖多了。一早吃完罐頭後,陽光打到哪,就睡到哪。
繼續閱讀全文 陽光打到哪就睡到哪

Word 教學:合併列印並分別存檔

Chung-Yuan Dye 於 Wednesday, December 23, 2015 10:58 PM 發表




Word Mail Merge  and Save Separate Documents
繼續閱讀全文 Word 教學:合併列印並分別存檔

Word 教學:合併列印

Chung-Yuan Dye 於 9:57 AM 發表
繼續閱讀全文 Word 教學:合併列印

Mathematica 教學:樂秀程式

Chung-Yuan Dye 於 Monday, December 14, 2015 5:43 PM 發表


mynum[luckynumbers__,n_]:=Block[{simulation,myresult},                          
(* 產稱n組中講號碼 *)                                                           
simulation=RandomSample[Range[49],6]&/@Range[n];                                
(* 把幸運號碼在n次中獎樣本裡面比對 *)                                           
myresult=ParallelTable[Length@Flatten[Position[simulation[[z]],#]&/@            
luckynumbers],{z,n}];                                                           
(* 輸出中獎機率 *)                                                              
{#[[1]],#[[2]]/n}&/@SortBy[N@Tally@myresult,First]                              
]                                                                           
(* 隨便一組號碼連買20000期 *)                                                   
mynum[RandomSample[Range[49],6],20000]                                          
(* {1,2,3,4,5,6} 連買20000期 *)                                                 
mynum[{1, 2, 3, 4, 5, 6}, 20000]   
繼續閱讀全文 Mathematica 教學:樂秀程式

Word長篇文章基礎排版

Chung-Yuan Dye 於 Monday, November 23, 2015 3:23 PM 發表







Word長篇文章基礎排版。
繼續閱讀全文 Word長篇文章基礎排版

Mathematica 教學:文字排列

Chung-Yuan Dye 於 Sunday, October 25, 2015 11:19 PM 發表


mystr=StringPartition[
"豫章故郡洪都新府星分翼軫地接衡廬襟三江而帶五湖控蠻荊而引甌越物華天寶龍光射牛斗之墟人傑地靈徐孺下陳蕃之榻雄州霧列俊彩星馳臺隍枕夷夏之交\
賓主盡東南之美都督閻公之雅望棨戟遙臨宇文新州之懿範襜帷暫駐十旬休暇勝友如雲千里逢迎高朋滿座騰蛟起鳳孟學士之詞宗紫電青霜王將軍之武庫家君作宰路\
出名區童子何知躬逢勝餞時維九月序屬三秋潦水盡而寒潭清煙光凝而暮山紫儼驂騑於上路訪風景於崇阿臨帝子之長洲得仙人之舊館層臺聳翠上出重霄飛閣流丹下\
臨無地鶴汀鳧渚窮島嶼之縈廻桂殿蘭宮即岡巒之體勢披繡闥俯雕甍山原曠其盈視川澤紆其駭矚閭閻撲地鍾鳴鼎食之家舸艦迷津青雀黃龍之舳雲銷雨霽彩徹區明落\
霞與孤鶩齊飛秋水共長天一色漁舟唱晚響窮彭蠡之濱雁陣驚寒聲斷衡陽之浦遙襟甫暢逸興遄飛爽籟發而清風生纖歌凝而白雲遏睢園綠竹氣凌彭澤之樽鄴水朱華光\
照臨川之筆四美具二難並窮睇眄於中天極娛遊於暇日天高地迥覺宇宙之無窮興盡悲來識盈虛之有數望長安於日下指吳會於雲間地勢極而南溟深天柱高而北辰遠關\
山難越誰悲失路之人萍水相逢盡是他鄉之客懷帝閽而不見奉宣室以何年嗟乎!時運不齊命途多舛馮唐易老李廣難封屈賈誼於長沙非無聖主竄梁鴻於海曲豈乏明時\
所賴君子安貧達人知命老當益壯寧移白首之心窮且益堅不墜青雲之志酌貪泉而覺爽處涸轍以猶懽北海雖賒扶搖可接東隅已逝桑榆非晚孟嘗高潔空餘報國之心阮籍\
猖狂豈效窮途之哭勃三尺微命一介書生無路請纓等終軍之弱冠有懷投筆慕宗慤之長風捨簪笏於百齡奉晨昏於萬里非謝家之寶樹接孟氏之芳鄰他日趨庭叨陪鯉對今\
茲捧袂喜托龍門楊意不逢撫凌雲而自惜鍾期既遇奏流水以何慚嗚呼!勝地不常盛筵難再蘭亭已矣梓澤丘墟臨別贈言幸承恩於偉餞登高作賦是所望於群公!敢竭鄙\
誠恭疏短引一言均賦四韻俱成請灑潘江各傾陸海雲爾滕王高閣臨江渚佩玉鳴鸞罷歌舞畫棟朝飛南浦雲珠簾暮捲西山雨閒雲潭影日悠悠物換星移幾度秋閣中帝子今\
何在檻外長江空自流!",1];

ntext[n_]:=Total@Flatten@Reverse@Map[If[Total[#]==255*3,0,1]&,
Rasterize["6",RasterSize->n][[1,1]][[10;;-4]],{2}];

num=SortBy[ParallelMap[{#,Abs[ntext[#]-Length@mystr]}&,Range[10,100]],Last][[1,1]];

mydata=Reverse@Map[If[Total[#]==255*3,0,1]&,
Rasterize["6",RasterSize->num][[1,1]][[10;;-4]],{2}];

mypos=Position[Flatten[mydata],1][[All,1]];

mydata2=Flatten[mydata];

Table[mydata2[[mypos[[i]]]]=mystr[[i]],{i,Length@mypos}];

Grid[Partition[mydata2,42]//.0->""]

繼續閱讀全文 Mathematica 教學:文字排列

Mathematica 教學:主成分分析

Chung-Yuan Dye 於 Saturday, August 15, 2015 5:30 PM 發表
With[{data=
Block[{t},
{#,3+#*0.2+RandomReal[NormalDistribution[0,1]]}&/@
Table[RandomReal[NormalDistribution[0,2]],{100}]]},
Manipulate[
Module[{p1=point1,p2=point2,m,v1,myline,pp,pcadata,
pcaslope},
pcaslope=
Divide@@Reverse@Eigensystem[Covariance[data]][[2,1]];
(*直線斜率*)
m=(p2[[2]]-p1[[2]])/(p2[[1]]-p1[[1]]);
(*計算投影座標*)
v1=point2-point1//N;
pcadata=p1+Projection[#-point1,v1]&/@data;
Column[{
"最大特徵根="<>ToString@Eigensystem[Covariance[data]][[1,1]],
"變異數="<>ToString@Variance[Normalize[v1].#&/@data],
"",
Plot[{m(x-p1[[1]])+p1[[2]],
pcaslope(x-p1[[1]])+p1[[2]]},{x,-20,20},
PlotStyle->{{Green,Thickness[0.01]},Automatic},
PlotRange->{{-10,10},{-7.5,12.5}},
Axes->False,
Frame->True,
AspectRatio->1,
Epilog->{Blue,PointSize[0.0125],Point[data],
Red,PointSize[0.025],Point[pcadata],
Dashed,MapThread[Line[{#1,#2}]&,{data,pcadata}]},
ImageSize->300]},Alignment->Center]],
{{point1,{-1,-5}},Locator},
{{point2,{2,1}},Locator}]]

繼續閱讀全文 Mathematica 教學:主成分分析

Mathematica 教學:最小平方法

Chung-Yuan Dye 於 5:24 PM 發表

Manipulate[
DynamicModule[{pts=RandomReal[{0,5},{k,2}],y,x,function},
LocatorPane[Dynamic[pts],
Dynamic[y[x_]=Normal@Fit[pts,Flatten@{1,Table[x^p,{p,power}]},x];
function=CoefficientList[y[x],x];
Plot[y[x],{x,0,10},PlotRange->{{0,10},{0,10}},
AspectRatio->1,
Frame->True,
Epilog->{
Text[Style[function.Table["x"^p,{p,0,power}],Italic,12],
Scaled[{0.5,0.8}]],
Point[pts],
Dashed,Red,Line[{#,{#[[1]],y[#[[1]]]}}]&/@pts}]]]],
{{k,6,"Points"},3,12,1,ControlType->PopupMenu},
{{power,2,"次方"},{1,2,3}}]

繼續閱讀全文 Mathematica 教學:最小平方法

Finally, the first acceptance of 2015 comes.

Chung-Yuan Dye 於 Thursday, January 15, 2015 6:08 PM 發表




Chung-Yuan Dye and Chih-Te Yang

Abstract

In this paper, we consider issues of sustainability in the context of joint trade credit and inventory management in which the demand depends on the length of the credit period offered by the retailer to its customers. We quantify the impacts of the credit period and environmental regulations on the inventory model. Starting with some mild assumptions, we first analyze the model with generalized demand and default risk rates under the Carbon Cap-and-Trade policy, and then we make some extensions to the model with the Carbon Offset policy. We further analytically examine the effects of carbon emission parameters on the retailer's trade credit and replenishment strategies. Finally, a couple of numerical examples and sensitivity analysis are given to illustrate the features of the proposed model, which is followed by concluding remarks.

Keywords: Environmental regulation; Inventory; Trade credit; Default risk; Carbon emissions
繼續閱讀全文 Finally, the first acceptance of 2015 comes.

Mathematica 教學:Interpolation 的函數要如何輸出

Chung-Yuan Dye 於 Tuesday, January 6, 2015 11:02 AM 發表




(* test data*)
plot1=Plot[PDF[LogNormalDistribution[0,1],x],{x,0,5}]
mypts=plot1[[1,1,-1,2,1]];
ListLinePlot[mypts]

(* models and parameters *)
myrule=b[coef_]:>ToExpression["b"<>ToString[coef]];
mymodel=Accumulate[b[#]*x^#&/@Range[0,10,1]/.myrule][[2;;-1]]
myvar=b[#]&/@Range[0,10]/.myrule

(* fitting models *)
myfit=FindFit[mypts,mymodel[[#]],myvar[[1;;#+1]],x]&/@
Range[Length@mymodel]

(* plot data and model *)
Plot[mymodel[[#]]/.myfit[[#]],{x,0,5},Epilog->Point[mypts],
PlotRange->{{0,5},{0,0.8}}]&/@Range[Length@mymodel]
繼續閱讀全文 Mathematica 教學:Interpolation 的函數要如何輸出

Thank you for your endless love.

Chung-Yuan Dye 於 Saturday, October 25, 2014 11:00 PM 發表


I love and miss you Mom. Thank you for your endless love, compassion, support and understanding.
繼續閱讀全文 Thank you for your endless love.

Mathematica 教學:矩陣元素取代

Chung-Yuan Dye 於 Thursday, September 18, 2014 11:27 AM 發表
 作者  kobenein (哈哈哈)                                         看板  MATLAB  標題  [問題] 矩陣元素取代 不用迴圈硬幹  時間  Wed Sep 17 20:01:56 2014 ───────────────────────────────────────  X = [0 0 0 1 1 1 1]; Y = [a0 a1;b0 b1;c0 c1];  如何不用迴圈硬幹  得到一個矩陣   [a0 a0 a0 a1 a1 a1 a1;  b0 b0 b0 b1 b1 b1 b1;  c0 c0 c0 c1 c1 c1 c1;];    謝謝

Map[{0,0,0,1,1,1,1}/.{0->#[[1]],1->#[[2]]}&,{{a0,a1},{b0,b1},{c0,c1}}]
繼續閱讀全文 Mathematica 教學:矩陣元素取代

Mathematica 教學:Branch-and-Bound method for Integer Programming

Chung-Yuan Dye 於 Tuesday, September 9, 2014 2:23 PM 發表


I write this program to draw the tree plot to demonstrate the Branch-and-Bound method for Integer Programming.

myIPTreePlot[lpprob_List,level_]:=Block[{initans,vars,BaB,myans},
initans=LinearProgramming@@lpprob;
vars=ToExpression["x"<>ToString[#]&/@Range[Length@lpprob[[1]]]];

BaB[{prob_,ans_}]:=Block[{bb,left,right,bbprob,mypath},
bb=Table[fun[var],{var,ans[[1,-1]]},{fun,{Floor,Ceiling}}];
left[n_]:={prob[[1]],Insert[prob[[2]],
-IdentityMatrix[Length@ans[[1,-1]]][[n]],-1],
Insert[prob[[3]],-bb[[n,1]],-1]};
right[n_]:={prob[[1]],Insert[prob[[2]],
IdentityMatrix[Length@ans[[1,-1]]][[n]],-1],
Insert[prob[[3]],bb[[n,2]],-1]};

mypath=
Quiet@Flatten[Map[{#,{Insert[ans[[1]],LinearProgramming@@#,-1],
Insert[ans[[2]],
Flatten[{#[[2,-1]],#[[3,-1]]}],-1]}}&,
Table[{left[n],right[n]},{n,Length@bb}],{2}],1];
mypath=If[FreeQ[#[[2,1,1;;-2]],#[[2,1,-1]]],#,{prob,ans}]&/@mypath;
mypath=If[Head[#[[2,1,-1]]]===LinearProgramming,{prob,ans},#]&/@mypath];

myans=Select[Flatten[NestList[Flatten[Map[BaB,#],1]&,
{{lpprob,{{initans},{Table[0,{1+Length@lpprob[[1]]}]}}}},
level],1][[All,2,2]],Length[#]>=2&];

TreePlot[Gather[Flatten[#[[1;;-2]]->#&/@myans,1]][[All,1]],
VertexLabeling->True,DirectedEdges->True,
VertexRenderingFunction->({Yellow,Black,
Text[Framed[If[#2[[-1,1;;-2]]===Table[0,{Length@lpprob[[1]]}],
Grid[{{initans},{lpprob[[1]].initans}},Frame->All,
Spacings->{1,1}],
Grid[{{Reduce[Thread[#2[[All,1;;2]].vars>=#2[[All,-1]]]]},
{LinearProgramming@@{lpprob[[1]],
Join[lpprob[[2]],#2[[All,1;;-2]]],
Join[lpprob[[3]],#2[[All,-1]]]}}},Frame->All,
Spacings->{2,2}]],Background->RGBColor[1,1,0.8],
FrameStyle->RGBColor[0.94,0.85,0.36]],#1]}&),
ImageSize->600]
]


myIPTreePlot[-{{3,4},{{2,1},{2,3}},{6,9}},5]

myIPTreePlot[{{-5,-8},{{-1,-1},{-5,-9}},{-6,-45}},5]

繼續閱讀全文 Mathematica 教學:Branch-and-Bound method for Integer Programming

Mathematica 教學:超長資料輸出

Chung-Yuan Dye 於 Thursday, September 4, 2014 11:51 PM 發表


(*告訴Mathematica當前Notebook的輸出資料長度無上限*)
SetOptions[EvaluationNotebook[],OutputSizeLimit->Infinity]
RandomReal[{0,1},{10000,2}]
繼續閱讀全文 Mathematica 教學:超長資料輸出

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 教學 微積分的運用