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 於 Friday, March 18, 2016 12:10 PM 發表


Journal of Veterinary Behavior: Clinical Applications and Research 裡這篇文章說不要常餵食,你的肥貓會更愛你。我現在每天只餵他吃一餐,不過他也開始霸佔滑鼠了。








繼續閱讀全文 愛犬阿寶

匆匆的,今年準備上小學了。

Chung-Yuan Dye 於 11:56 AM 發表


剛剛帶資料到附近的過小報到。時間過得真快,匆匆的,今年準備上小學了。
繼續閱讀全文 匆匆的,今年準備上小學了。

Mathematica 教學:Pi Day

Chung-Yuan Dye 於 Monday, March 14, 2016 6:08 PM 發表
str=Reverse@Rasterize[Style[\[Pi],FontFamily->"Kokonor",Bold,Red,FontSize->20], 
RasterSize->20,ImageSize->{Automatic,25}][[1,1]][[21;;-20]];

mytext=Map[If[Total@#==255*3,"",0]&,str,{2}];

mypos=Position[Map[If[Total@#==255*3,1,0]&,str,{2}],0];

mypi=Drop[Characters[ToString@N[Pi,Length@mypos]],{2}];

Set[mytext[[mypos[[#,1]],mypos[[#,2]]]],Style[mypi[[#]],
Lighter@RandomColor[]]]&/@Range[Length@mypi];

Grid[mytext,Spacings->{0.2,0.2},Background->Black,
ItemStyle->{Directive[{RandomReal[255],RandomReal[255],
RandomReal[255]},18,Italic],None}]
繼續閱讀全文 Mathematica 教學:Pi Day

愛犬阿寶

Chung-Yuan Dye 於 Thursday, March 3, 2016 11:24 PM 發表


修水龍頭的師父說完他家那隻老貓的一些習性後,我才驚覺,原來阿寶也老了。

繼續閱讀全文 愛犬阿寶

Mathematica 教學:Generate a Tiny Planet Photo

Chung-Yuan Dye 於 Sunday, February 28, 2016 9:04 PM 發表



mypic=your pic;
ParametricPlot3D[{v*Cos[u],v*Sin[u],0.0035v},{u,0,2Pi},{v,0,1},
Mesh->0,BoundaryStyle->None,PlotStyle->Texture[mypic],
ViewPoint->{0,0,1},Boxed->False,Axes->None,PlotPoints->50,
ImagePadding->None,
Lighting->{{"Directional",White,{{0,3,2},{0,3,0}}}}]

ParametricPlot3D[{v*Cos[u],v*Sin[u],0.0035v},{u,0,2Pi},{v,0,1},
Mesh->0,BoundaryStyle->None,PlotStyle->Texture[ImageRotate[mypic,Pi]],
ViewPoint->{0,0,1},Boxed->False,Axes->None,PlotPoints->50,
ImagePadding->None,
Lighting->{{"Directional",White,{{0,3,2},{0,3,0}}}}]



繼續閱讀全文 Mathematica 教學:Generate a Tiny Planet Photo

Mathematica 教學:讀取PTT資料

Chung-Yuan Dye 於 Tuesday, February 23, 2016 12:05 AM 發表




(* 輸入資料 *)
data[i_]:=Import["https://www.ptt.cc/bbs/Mathematica/index"<>
ToString@i<>".html",{"XMLObject"}];

(* 讀取文章欄位資料 *)
mydata=Flatten[Flatten/@
Transpose@
{
Cases[data[#],XMLElement["div",{"class"->"date"},{date_}]:>date,
Infinity],
Cases[data[#],XMLElement["div",{"class"->"author"},{author_}]:>author,
Infinity],
Cases[data[#],XMLElement["a",{"shape"->"rect","href"->link_},{title_}]:>{title,link},
Infinity]
}&/@Range[34],1]

(* 分割年度 *)
mydate=Split[Quiet@Flatten@DateList[StringReplace[#,""->""]][[{2,3}]]&/@
mydata[[All,1]],#1[[1]]<=#2[[1]]&];

(* 重新定義日期  *)
mydata[[All,1]]=Flatten[MapThread[
Flatten/@Thread[{#1,#2}]&,{Range[2011,2016],mydate}],1];

(* 文章直方圖 *)
DateHistogram[mydata[[All,1]],#]&/@{"Month","Year"}

DateHistogram[Select[mydata,#[[2]]=="chungyuandye"&][[All,1]],#]&/@{"Month","Year"}

繼續閱讀全文 Mathematica 教學:讀取PTT資料

淚人兒

Chung-Yuan Dye 於 Saturday, February 13, 2016 11:31 PM 發表



繼續閱讀全文 淚人兒

愛犬阿寶

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 教學 用函數抓每行最後一筆資料