除了專業領域外,Mathematica 在日常生活有什麼有趣用處?

不然它也不會推出家庭版吧


Mathematica本身就是一個大萌物,它可以很方便的做許多事情:創意,音樂,遊戲,視覺等,是居家生活找樂子的必備利器啊。下面給出一些鏈接,你可以自己去看:

1,這個是清華大學一位同學寫的關於Mma的博客:

http://hi.baidu.com/new/van_der_kommu

2,這是另一位同學寫的關於音樂方面的文章,多用Mma來實現

http://hi.baidu.com/molly_kang

3,這是我寫的關於Mma的文章,大多玩物喪志:

http://www.withparadox2.com/archives/tag/mathematica-2

4,這是一個專門玩Mma的博客,到了喪心病狂的地步:

http://playingwithmathematica.com/

5,這是幾篇stackexchange上的神作,請樓主自行閱之:

http://mathematica.stackexchange.com/questions/2334/how-to-create-word-clouds

http://mathematica.stackexchange.com/questions/11350/xkcd-style-graphs

http://mathematica.stackexchange.com/questions/3345/how-to-make-an-inkblot

http://stackoverflow.com/questions/8479058/how-do-i-find-waldo-with-mathematica

。。。。。。

6,wolfram blog有眾多搞怪文章:

http://blog.wolfram.com/

7,大殺器之wolfram旗下的demonstration,8000多款用Mathematica寫的玩意,樓主可以找你自己感興趣的那一部分:

http://demonstrations.wolfram.com/

8,這裡還有一篇Mathematica資源合集,裡面藏寶良多:

http://mathematica.stackexchange.com/questions/18/where-can-i-find-examples-of-good-mathematica-programming-practice


就是在「專業領域」也有有趣的應用啊,沒事賣個萌啥的……Matlab行嗎?

比如多項式展開:

要不來個因式分解?

或者來做個微積分玩玩??

來,畫幅函數圖像吧:

最後來個密集的…………

我真的不是來賣萌的………………


Mathematica?這是我的廚房!

怎麼說?請看:

Marvin(下廚房)

歡迎來切磋虛擬廚藝。

這個答案在草稿放了好久了,不忍心放上來打擾這裡的氣氛……今天大年初一,我就想到廚藝(初一)啦~ 最終還是放上來了……


不涉及科學研究的話,Mma的各種奇葩的功能確實可以讓人對其做各種Play。。。

比如用其內部各種音樂方面的東西來演奏玩弄Mathematica的樂器演奏功能,可以用其強大的繪製圖表功能來做神奇寶貝的圖鑑Scrapy+Mathematica製作神奇寶貝圖鑑書籤,還可以做簡單的爬蟲抓取豆瓣相冊圖片——Mathematica版,甚至還有很多人用其來做一些腳本程序之類的。。比如發微博,發人人,分析郵件,破解密碼之類的。。。


1.

background =

Rasterize[

Graphics[{RGBColor[{0.85, 0.85, 0.85}], Rectangle[{0, 2}, {5.6, 5}],

RGBColor[{0.169, 0.173, 0.149}], Rectangle[{0, 1.5}, {5.6, 2}],

RGBColor[{0.298, 0.286, 0.227}], Rectangle[{0, -7.5}, {5.6, 1.5}],

Rectangle[{1.4, 1.4}, {1.6, 2.1}], Rectangle[{0, 2}, {5.6, 2.1}],

Rectangle[{4, 1.4}, {4.2, 2.1}], RGBColor[{0.447, 0.447, 0.439}],

Rectangle[{2.3, 1.4}, {3.3, 2.05}],

Text[Style["NAIVE", RGBColor[{.7, .7, .7}], 15], {2.8, 1.75}],

RGBColor[{0.224, 0.208, 0.165}], Thickness[0.015],

Line[{{{2.9, 1.35}, {2.9, 0.0}, {2.7, -0.45}}, {{2.7,

1.35}, {2.7, -7.45}}}],

Circle[{0.05, 1.47}, 1, {3 Pi/2, 2 Pi}],

Circle[{5.55, 1.47}, 1, {Pi, 3 Pi/2}], RGBColor[{0.82, 0.8, 0.8}],

Polygon[{{.8, 5}, {2.3, 4}, {2.8, 4.9}, {3.3, 4}, {4.8, 5}}],

RGBColor[{0.69, 0.227, 0.18}],

Polygon[{{2.8, 4.9}, {2.4, 4.2}, {2.65, 3.85}, {2.4, 2.67}, {2.8,

2.2}, {3.2, 2.67}, {2.9, 3.85}, {3.2, 4.2}}], Black,

Thickness[0.001], Line[{{2.65, 3.85}, {2.9, 3.85}}],

Text[Style["young", 10, Red], {2.7, 2.55}, Automatic, {2, -2.4}]},

ImageSize -&> Large]]; {pic1, pic2} =

ImageResize[ImageCrop[#], {75, 60}] /@ {Rasterize[

Graphics[{RGBColor[{0.886, 0.721, 0.556}],

Rectangle[{-0.5, 0}, {.5, 1}], RGBColor[{0.486, 0.356, 0.047}],

Rectangle[{-0.5, 0.55}, {-0.45, 0.85}],

Rectangle[{0.45, 0.55}, {0.5, 0.85}],

Rectangle[{-.07, 0.38}, {-.03, 0.42}],

Rectangle[{0.03, 0.38}, {0.07, 0.42}](*nostrils*), Black,

Thickness[0.035],

Line[{{-0.42, 0.5}, {-0.42, 0.8}, {-0.1, 0.8}, {-0.1,

0.5}, {-0.42, 0.5}}],

Line[{{0.42, 0.5}, {0.42, 0.8}, {0.1, 0.8}, {0.1, 0.5}, {0.42,

0.5}}], Line[{{-.1, 0.65}, {.1, 0.65}}]}], ImageSize -&> 100],

Rasterize[

Graphics[{RGBColor[{0.886, 0.721, 0.556}],

Rectangle[{-0.5, 0}, {.5, 1}], RGBColor[{0.486, 0.356, 0.047}],

Rectangle[{-0.5, 0.55}, {-0.45, 0.85}],

Rectangle[{0.45, 0.55}, {0.5, 0.85}],

Rectangle[{-.07, 0.38}, {-.03, 0.42}],

Rectangle[{0.03, 0.38}, {0.07, 0.42}](*nostrils*), Red,

Thickness[0.02], Line[{{-.05, 0.38}, {-.05, 0.28}}],

Line[{{.05, 0.38}, {.05, 0.01}}], Black, Thickness[0.03],

Rotate[Line[{{-0.42, 0.5}, {-0.42, 0.8}, {-0.1, 0.8}, {-0.1,

0.5}, {-0.42, 0.5}}], 0.44],

Rotate[Line[{{0.42, 0.5}, {0.42, 0.8}, {0.1, 0.8}, {0.1,

0.5}, {0.42, 0.5}}], 30],

Line[{{-0.05, 0.63}, {.1, 0.65}}]}]]};

wallPic =

ImageResize[

ImageCrop@

Rasterize[

Style["香港
記者", Bold, "Title", LineSpacing -&> {0.5, 10}],

Background -&> RGBColor[{0.298, 0.286, 0.227}]], 60];

init := Block[{}, w = 5; h = 15.5; d = .5; l = .5; s = 5; n = 3;

r = .5; y = r; x = 2; vx = 0; vy = 0.1; accy = 10^-4.5;

score = 0; theEnd = False;

wallsPos =

Thread[{RandomInteger[w - 1, n],

Range[s, n s, s] + RandomReal[{-1, 1}, 3]}];]

updateWalls := Block[{}, wallsPos[[All, 2]] -= vy; vy += accy;

If[wallsPos[[1, 2]] &< 0, score++;

wallsPos = Drop[wallsPos, 1];

wallsPos =

Join[wallsPos,

Thread[{RandomInteger[w - 1, 1], n s + RandomReal[{-1, 1}]}]]];

walls = {White, Rectangle[{#[[1]] - d, #[[2]] - l}],

Inset[wallPic, #, Automatic, 1.1]} /@ wallsPos];

updateCar := Block[{},

If[Min[Norm /@ (wallsPos - {{x, y}, {x, y}, {x, y}})] &< 0.95,

gameOver];

Car = {White, Rectangle[{x - .5, y - .45}, {x + .5, y + .45}],

Inset[If[theEnd, pic2, pic1], {x, y}, Automatic, 1.15]}];

init;

game = CreateScheduledTask[(updateWalls; updateCar), 0.001];

StartScheduledTask[game];

gameOver := Block[{}, StopScheduledTask[game]; theEnd = True;];

EventHandler[Panel[

Row[{

Graphics[Dynamic@{walls, Car},

PlotRange -&> {{-0.5, w - .5}, {0, h - 3}}, Frame -&> False,

FrameTicks -&> None, FrameStyle -&> Directive[Black, Thick],

ImageSize -&> 200,

Prolog -&> Inset[background, Automatic, Automatic, 5.9]],

Column[{Style[" CRAZY
HONGKONG
JOURNALIST",

FontColor -&> White, Bold, FontSize -&> 21],

Dynamic@Style[If[theEnd, " GAME
OVER", "吼啊"],

FontColor -&> Red, Bold, FontSize -&> 30], ,

Style["TIME:", FontColor -&> White, FontSize -&> 30], ,

Row[{Style["+", FontColor -&> Red, FontSize -&> 40], , ,

Dynamic@Style[score, FontColor -&> Red, Bold,

FontSize -&> 45], , ,

Style["S", FontColor -&> Red, FontSize -&> 35]}],

Style["", FontColor -&> White, FontSize -&> 30],

Dynamic[If[theEnd,

Speak@RandomChoice[{"im angry",

"nimen bi jing han shi too yong", "nimen a naive",

"han xu yao xue xiyi ge"}]];],

Dynamic[

If[Mod[score, 20] == 19, score++;

Speak@RandomChoice[{"interesting", "excited",

"exciting"}]];],

Row[{"",

Button["BE IN RED", init; StartScheduledTask[game],

Background -&> Red]}]}, Center]

}], Background -&> Black, ImageSize -&> {375, 520}

], {"LeftArrowKeyDown" :&> If[x &> 0, x += -1, 0],

"RightArrowKeyDown" :&> If[x &< w - 1, x += 1, w - 1],

"UpArrowKeyDown" :&> If[y &< h - 1, y += 1, h - 1],

"DownArrowKeyDown" :&> If[y &> 1, y += -1, 0]}]

(SelectionMove[EvaluationNotebook[], Previous, Cell];

SelectionMove[EvaluationNotebook[], Before, CellContents];

SelectionMove[EvaluationNotebook[], Next, Character])

看了Excited Frog,就把之前寫的一個稍微一改,參考:code golf - Flappy Bird Clones :)

2

AudioAmplify[LowpassFilter[Audio[圖(*上面的圖存JPG*)// ImageData // Flatten], Quantity[850, "Hertz"]], 1.5]

3.

Clear["Global`*"]

clo = Graphics[{RGBColor[{0.85, 0.85, 0.85}],

Rectangle[{0, 2}, {5.6, 5}], RGBColor[{0.169, 0.173, 0.149}],

Rectangle[{0, 1.5}, {5.6, 2}], RGBColor[{0.298, 0.286, 0.227}],

Rectangle[{0, 0}, {5.6, 1.5}], Rectangle[{1.4, 1.4}, {1.6, 2.1}],

Rectangle[{0, 2}, {5.6, 2.1}], Rectangle[{4, 1.4}, {4.2, 2.1}],

RGBColor[{0.447, 0.447, 0.439}],

Rectangle[{2.3, 1.4}, {3.3, 2.05}],

Text[Style["NAIVE", RGBColor[{.7, .7, .7}], 18], {2.8, 1.75}],

RGBColor[{0.224, 0.208, 0.165}], Thickness[0.015],

Line[{{{2.9, 1.4}, {2.9, 0.7}, {2.7, 0.45}}, {{2.7, 1.4}, {2.7,

0}}}], RGBColor[{0.82, 0.8, 0.8}],

Polygon[{{.8, 5}, {2.3, 4}, {2.8, 4.9}, {3.3, 4}, {4.8, 5}}],

RGBColor[{0.69, 0.227, 0.18}],

Polygon[{{2.8, 4.9}, {2.4, 4.2}, {2.65, 3.85}, {2.4, 2.67}, {2.8,

2.2}, {3.2, 2.67}, {2.9, 3.85}, {3.2, 4.2}}], Black,

Thickness[0.001], Line[{{2.65, 3.85}, {2.9, 3.85}}],

Text[Style["young", 13, Red], {2.7, 2.55}, Automatic, {2, -2.4}]}];

white = Graphics[{RGBColor[{0.85, 0.85, 0.85}], Rectangle[]}];

ribs = Graphics[{RGBColor[{0.85, 0.85, 0.85}],

Rectangle[{0, 2}, {3, 5}], RGBColor[{0.169, 0.173, 0.149}],

Rectangle[{0, 1.5}, {3, 2}], RGBColor[{0.298, 0.286, 0.227}],

Rectangle[{0, 0}, {3, 1.5}], Rectangle[{1.4, 1.4}, {1.6, 2.1}],

Rectangle[{0, 2}, {3, 2.1}]}];

back = Graphics[{RGBColor[{0.85, 0.85, 0.85}],

Rectangle[{0, 2}, {5.6, 5}], RGBColor[{0.169, 0.173, 0.149}],

Rectangle[{0, 1.5}, {5.6, 2}], RGBColor[{0.298, 0.286, 0.227}],

Rectangle[{0, 0}, {5.6, 1.5}], Rectangle[{1.4, 1.4}, {1.6, 2.1}],

Rectangle[{0, 2}, {5.6, 2.1}], Rectangle[{4, 1.4}, {4.2, 2.1}],

White, Rectangle[{1.5, 2.2}, {4.1, 4.8}],

Text[Style["90", Bold, Black, Italic, 118], {2.7, 3.8},

FormatType -&> StandardForm],

Text[Style["YEARS", Bold, Underlined, Gray, Italic, 22], {3.2,

2.9}], Text[

Style["1926.08.17-[Infinity]", Bold, Gray, Italic, 20], {2.8,

2.4}]}];

sides1 = {back, ribs, clo, ribs, back, white};

v1 = {{0, -2.8, 2}, {3, -2.8, 2}, {3, 2.8, 2}, {0, 2.8, 2}, {0, -2.8,

7}, {3, -2.8, 7}, {3, 2.8, 7}, {0, 2.8, 7}};

idx = {{1, 2, 3, 4}, {1, 2, 6, 5}, {2, 3, 7, 6}, {3, 4, 8, 7}, {4, 1,

5, 8}, {5, 6, 7, 8}};

facebefore =

Graphics[{RGBColor[{0.886, 0.721, 0.556}],

Rectangle[{-0.5, 0}, {.5, 1}], RGBColor[{0.486, 0.356, 0.047}],

Rectangle[{-0.5, 0.55}, {-0.45, 0.85}],

Rectangle[{0.45, 0.55}, {0.5, 0.85}],

Rectangle[{-.07, 0.38}, {-.03, 0.42}],

Rectangle[{0.03, 0.38}, {0.07, 0.42}](*nostrils*), Black,

Thickness[0.035],

Line[{{-0.42, 0.5}, {-0.42, 0.8}, {-0.1, 0.8}, {-0.1,

0.5}, {-0.42, 0.5}}],

Line[{{0.42, 0.5}, {0.42, 0.8}, {0.1, 0.8}, {0.1, 0.5}, {0.42,

0.5}}], Line[{{-.1, 0.65}, {.1, 0.65}}]}];

face = Graphics[{RGBColor[{0.886, 0.721, 0.556}],

Rectangle[{-0.5, 0}, {.5, 0.4}], RGBColor[{0.486, 0.356, 0.047}],

Rectangle[{-0.5, .4}, {.5, 1}]}];

facenone = Graphics[{RGBColor[{0.886, 0.721, 0.556}], Rectangle[]}];

facel = Graphics[{RGBColor[{0.886, 0.721, 0.556}], Rectangle[],

RGBColor[{0.486, 0.356, 0.047}],

Polygon[{{0, 0.55}, {0.25, 0.55}, {0.25, .65}, {.4, .65}, {.4,

0.45}, {1, 0.45}, {1, 1}, {0.4, 1}, {.4, 0.85}, {0, .85}}]}];

facer = ImageReflect[Rasterize@facel, Left -&> Right];

deck = Rotate[

Graphics[{RGBColor[{0.894, 0.882, 0.675}],

Rectangle[{0, 0}, {5, 24}],

Text[Style[

"Were it to
benefit
my country
I would lay
down my

life;
What then is
risk to me?", Gray, Italic, 12], {2.5, 20}],

Text[Style["CHN", Bold, Red, Italic, 38], {2.5, 1}],

Text[Style[" DO NOT
MAKE BIG NEWS", Bold, Red, 10], {2.5,

3}]}], Pi/2];

sides = {facenone, facebefore, facel(*l*), face(*u*), facer(*r*),

face(*b*)};

v = {{0, -1.2, 7}, {3, -1.2, 7}, {3, 1.2, 7}, {0, 1.2, 7}, {0, -1.2,

9.5}, {3, -1.2, 9.5}, {3, 1.2, 9.5}, {0, 1.2, 9.5}};

idx = {{1, 2, 3, 4}, {1, 2, 6, 5}, {2, 3, 7, 6}, {3, 4, 8, 7}, {4, 1,

5, 8}, {5, 6, 7, 8}};

vtc = {{0.02, 0.02}, {0.98, 0.02}, {0.98, 0.98}, {0.02, 0.98}};

rowing = Table[

Show[{Graphics3D[{EdgeForm[], RGBColor[{0.298, 0.286, 0.227}](*leg*),

Cuboid[{6.5, 0.1, 0}, {0, 2.5, 2}],

Cuboid[{6.5, -2.5, 0}, {0, -0.1, 2}],

RGBColor[{0.125, 0.114, 0.094}],(*food*)

Cuboid[{7, .5, 0}, {6.5, 2, 1.8}],

Cuboid[{7, -2, -0.4}, {0, -.5, 1.8}],

Rotate[{RGBColor[{0.85, 0.85, 0.85}],(*arm*)

Cuboid[{2.3, 2.9, 3.5}, {0.5, 4, 6.5}],(*wrist*)White,

Cuboid[{2.2, 3.9, 3}, {0.6, 3, 3.5}],

RGBColor[{0.886, 0.721, 0.556}],(*hand*),

Cuboid[{2.1, 3.1, 2.5}, {0.7, 3.8, 3}], Black,

Tube[{{0.6, 3.5, 2.7}, {-6.5, 3.5, 2.7}}],(*Paddle*)

LightPurple, Cuboid[{-6.5, 3, 2.65}, {-9, 4, 2.7}]},

a Degree, {0, 1, 0}, {1, 3.7, 6}],

Rotate[{RGBColor[{0.85, 0.85, 0.85}],(*arm*)

Cuboid[{3.5, -4, 4.5}, {0.5, -2.9, 6}],(*wrist*)White,

Cuboid[{4, -3.9, 4.6}, {3.5, -3, 5.9}],

RGBColor[{0.886, 0.721, 0.556}],(*hand*),

Cuboid[{4.5, -3.8, 4.7}, {4, -3.1, 5.8}], Black,

Tube[{{4.2, -3.5, 4.8}, {4.2, -3.5, -1}}],(*Paddle*)

LightPurple,

Cuboid[{4.25, -4, -3.5}, {4.2, -3, -1}]}, -(a +

50) Degree, {0, 1, 0}, {1.25, -3.5, 5.25}],

(*BOAT*)RGBColor[{0.894, 0.882, 0.675}],

Cuboid[{16, -2.5, -.25}, {-8, 2.5, 0}],

Cuboid[{13, -2.5, -0.5}, {-5, 2.5, -.25}],

Cuboid[{11, -2, -.75}, {-4, 2, -.5}], EdgeForm[], White,

Rotate[Table[{Texture[sides[[i]]],

GraphicsComplex[v,

Polygon[idx[[i]], VertexTextureCoordinates -&> vtc]]}, {i,

6}], (a + 145) Degree, {0, 0, 1}, {1.5, 0, 8.5}], {Texture[

deck], Polygon[{{-8, -2.5, 0}, {16, -2.5, 0}, {16, 2.5,

0}, {-8, 2.5, 0}},

VertexTextureCoordinates -&> {{0, 0}, {1, 0}, {1, 1}, {0,

1}}]}, White,

Table[{Texture[sides1[[i]]],

GraphicsComplex[v1,

Polygon[idx[[i]], VertexTextureCoordinates -&> vtc]]}, {i,

6}]}, Boxed -&> False,

Method -&> {"RotationControl" -&> "Globe"},

AspectRatio -&> Automatic, Lighting -&> "Neutral",

Background -&> Lighter[LightBlue, 0.5]],

Plot3D[{.3 Sin[x + y + a] - .5, -4}, {x, -10, 20}, {y, -8, 8},

BoundaryStyle -&> Directive[LightBlue, Thick], Filling -&> Bottom,

FillingStyle -&> {Blue, Opacity[0.05]}, Mesh -&> None,

PlotStyle -&> Directive[Blue, Opacity[0.2]]]}], {a,

Join[#, Reverse@#] @Range[-100, -10, 5]}];

rowing[[1]]

box = MapThread[Min, Rasterize[#, "RasterSize"] /@ rowing];

Export["rowing.gif", ImageCrop[Rasterize[#], box] /@ rowing,

"DisplayDurations" -&> 0.1]

SystemOpen[DirectoryName[AbsoluteFileName["rowing.gif"]]]

4.

Clear["Global`*"]

clo = Graphics[{RGBColor[{0.188, 0.192, 0.207}],

Polygon[{{0, 0}, {0, 5}, {1.7, 3.5}, {3, 5}, {3, 0}}],

RGBColor[{0.1, 0.1, 0.107}],

Polygon[{{1.7, 3.5}, {2.1, 3.95}, {1.8, 4.5}, {2, 5}, {1.2,

5}, {1.4, 4.5}, {1.2, 3.9}}], Black, Thickness[0.01],

Line[{{1.7, 3.5}, {1.3, 3}, {1.3, 0}}], PointSize[0.05],

RGBColor[{0.258, 0.262, 0.278}],

Point[#] /@ ({1.5, #} /@ Range[0.3, 3, 0.6])}];

white = Graphics[{White, Rectangle[]}];

black = Graphics[{RGBColor[{0.227, 0.239, 0.212}], Rectangle[]}];

sides1 = {black, black, clo, black, black, white};

v1 = {{0, -1.5, 2}, {3, -1.5, 2}, {3, 1.5, 2}, {0, 1.5, 2}, {0, -1.5,

7}, {3, -1.5, 7}, {3, 1.5, 7}, {0, 1.5, 7}};

facebefore =

Graphics[{RGBColor[{0.886, 0.721, 0.556}],

Rectangle[{-0.5, 0}, {.5, 1}], RGBColor[{0.486, 0.356, 0.047}],

Rectangle[{-0.5, 0.55}, {-0.45, 0.85}],

Rectangle[{0.45, 0.55}, {0.5, 0.85}],

Rectangle[{-.07, 0.38}, {-.03, 0.42}],

Rectangle[{0.03, 0.38}, {0.07, 0.42}](*nostrils*), Black,

Thickness[0.035],

Line[{{-0.42, 0.5}, {-0.42, 0.8}, {-0.1, 0.8}, {-0.1,

0.5}, {-0.42, 0.5}}],

Line[{{0.42, 0.5}, {0.42, 0.8}, {0.1, 0.8}, {0.1, 0.5}, {0.42,

0.5}}], Line[{{-.1, 0.65}, {.1, 0.65}}]}];

face = Graphics[{RGBColor[{0.886, 0.721, 0.556}],

Rectangle[{-0.5, 0}, {.5, 0.4}], RGBColor[{0.486, 0.356, 0.047}],

Rectangle[{-0.5, .4}, {.5, 1}]}];

facenone = Graphics[{RGBColor[{0.886, 0.721, 0.556}], Rectangle[]}];

facel = Graphics[{RGBColor[{0.886, 0.721, 0.556}], Rectangle[],

RGBColor[{0.486, 0.356, 0.047}],

Polygon[{{0, 0.55}, {0.25, 0.55}, {0.25, .65}, {.4, .65}, {.4,

0.45}, {1, 0.45}, {1, 1}, {0.4, 1}, {.4, 0.85}, {0, .85}}]}];

facer = ImageReflect[Rasterize@facel, Left -&> Right];

sides = {facenone, facebefore, facel(*l*), face(*u*), facer(*r*),

face(*b*)};

v = {{0, -1.2, 7}, {3, -1.2, 7}, {3, 1.2, 7}, {0, 1.2, 7}, {0, -1.2,

9.5}, {3, -1.2, 9.5}, {3, 1.2, 9.5}, {0, 1.2, 9.5}};

idx = {{1, 2, 3, 4}, {1, 2, 6, 5}, {2, 3, 7, 6}, {3, 4, 8, 7}, {4, 1,

5, 8}, {5, 6, 7, 8}};

vtc = {{0.02, 0.02}, {0.98, 0.02}, {0.98, 0.98}, {0.02, 0.98}};

Graphics3D[{RGBColor[{0.972, 0.968, 0.788}], EdgeForm[],

Cuboid[{4, 3, -1}, {0, 4, 2}], Cuboid[{4, 3, 2}, {0, 5, 2.5}],

Cuboid[{4, -4, -1}, {0, -3, 2}], Cuboid[{4, -5, 2}, {0, -3, 2.5}],

Cuboid[{0, -5, -1}, {-2, 5, 7.5}], RGBColor[{0.251, 0.196, 0.145}],

Cuboid[{4, -5, -1}, {0, -4, 2}], Cuboid[{4, 4, -1}, {0, 5, 2}],

RGBColor[{0.227, 0.239, 0.212}](*leg*),

Cuboid[{4.5, 0.1, -0.5}, {0, 2.5, 2}],

Cuboid[{4.5, -2.5, -0.5}, {0, -0.1, 2}],

RGBColor[{0.125, 0.114, 0.094}],(*food*)

Cuboid[{4.3, -2.3, -1}, {0, -0.3, -0.5}],

Cuboid[{4.3, 0.3, -1}, {0, 2.3, -0.5}],

RGBColor[{0.227, 0.239, 0.212}],(*body*)

Cuboid[{3, -2.8, 2}, {0, -1.5, 7}],

Cuboid[{3, 1.5, 2}, {0, 2.8, 7}],(*arm*)

Cuboid[{2.3, 2.9, 3.5}, {0.5, 4, 6.5}],

Cuboid[{3.5, -4, 4.5}, {0.5, -2.9, 6}], Thickness[0.004],

Line[{{{3, 1.5, 2}, {3, 1.5, 7}}, {{3, -1.5, 2}, {3, -1.5, 7}}}],

White,(*wrist*)Opacity[1], Cuboid[{2.2, 3, 3}, {0.6, 3.9, 3.5}],

Cuboid[{4, -3.9, 4.6}, {3.5, -3, 5.9}],

RGBColor[{0.886, 0.721, 0.556}],(*hand*),

Cuboid[{2.1, 3.1, 2.5}, {0.7, 3.8, 3}],

Cuboid[{4.5, -3.8, 4.7}, {4, -3.1, 5.8}], EdgeForm[], White,

Rotate[Table[{Texture[sides[[i]]],

GraphicsComplex[v,

Polygon[idx[[i]], VertexTextureCoordinates -&> vtc]]}, {i, 6}],

90 Degree, {0, 0, 1}, {1.5, 0, 8.5}], White,

Table[{Texture[sides1[[i]]],

GraphicsComplex[v1,

Polygon[idx[[i]], VertexTextureCoordinates -&> vtc]]}, {i, 6}]},

Boxed -&> False, Method -&> {"RotationControl" -&> "Globe"},

AspectRatio -&> Automatic, Lighting -&> "Neutral",

Background -&> Lighter[Gray, 0.5]]


最近的人形曲線很火,我的這篇轉來的日誌介紹了Mathematica生成人形曲線的方法

來自http://mathematica.stackexchange.com/questions/17704/how-to-create-new-person-curve

稍加改編

人形曲線當初是藉助江南Style火今早在果殼逛時,找到了這樣的帖子http://www.guokr.com/post/440086/,就說是把輪廓圖片變成曲線方程

經兩小時實驗成功,代碼時可以跑的,直接貼圖

1、這是輸入圖片

2、貼代碼,主要是利用傅里葉變換:Fourier[x],還有將係數的小數近似化為分數,就是為了形式更好看:Rationalize[...],關鍵的就是tocurveparam 是定義一個函數

img導入圖像並處理

3、

lines將圖像打散為離散點

Manipulate生成動態效果

看好了,我要變形了!

4、生成GIF動畫

生成的GIF

每個都是含500組Sin()形式的傅里葉展開式


我在新浪微博有一個小號(新浪微博註冊),專門用Mathematica來自動轉發網路漫畫。代碼見《用Mathematica轉髮網漫》。

@廖彬 還用Mathematica寫博客(pheiztu的小站)。


家庭版的意思是非商業版,也就是價格適合個人愛好者購買但不允許用於商業活動中,並不是說面向家庭日常生活的。不過Mathematica本身確實有很多有趣的用處。

代碼的例子別的答案講得很多了,不過我這裡還想提一下:Mathematica現在推出了運行在樹莓派(Raspberry Pi)上的功能完整的 免費 的移植版(改名叫做Wolfram Language了),並增加了(並計劃持續增加)許多硬體介面功能,意味著用戶可以在Mathematica內實現對硬體的交流和操作。所以你可以用它來搭建自己的智能家庭,或者製作機器人,等等……

官方主頁:

Wolfram + Raspberry Pi Project: A Wolfram Engine on Every Raspberry Pi

安裝方式:

raspberrypi.org 的頁面

官方論壇:

Raspberry Pi Forum in Mathematica Community


補充一個鏈接,http://bugman123.com

鏈接中有許多有趣的Mathematica代碼,不過有點年代久遠了,有的代碼需要稍加修改才能運行,

還有不少代碼有一些優化餘地(比如Compile等)


做高數作業!


Manipulate[

ParametricPlot3D[{3 (y^(1/(-0.15 Exp[-t/2.5] Sin[2 Pi/2.5 t] +

1)) Log[y]) Exp[-1.3 Abs[(1/4 Sqrt[1 + 16 (z)^2] - 1)]^2 ]

- Exp[-4 ((18 y (-0.15 Exp[-t/2.5] Sin[2 Pi/2.5 t] + 1) -

18/E)^2 + (9 (1/4 Sqrt[1 + 16 (z)^2] - 1))^2)^2]/12 , z,

y} /. t -&> 0, {y, 0, 1}, {z, -2, 2}, BoxRatios -&> {1, 3.4, 1.7},

Boxed -&> False, Axes -&> None, Mesh -&> None,

ColorFunction -&> RGBColor[249/256, 202/256, 194/256 ],

PlotStyle -&>

Directive[RGBColor[249/256, 202/256, 194/256 ], Opacity[1],

Specularity[White, 20]], PerformanceGoal -&> "Quality",

PlotPoints -&> 50, ViewPoint -&> {-1, -x, y}], {{x, 1.7}, 1, 2,

0.1}, {{y, 0.3}, 0, 1, 0.1}]

不用謝...


嚴重同意mathematica就是一個大萌物。不但它是一個萌物,連mathematica公司讓人感覺也是一個大萌物。


試試敲入兩個等號,用 Wolfram | Alpha 查一下「Pokemon」


去WolframChina官方微博就知道他為什麼是個大萌物了


Matlab可以玩flip bird算不算……


推薦閱讀:

Mathematica 有什麼奇技淫巧?
Wolfram Language 對於一個普通程序員有什麼意義?
如何系統的學習Mathematica?
mathematica軟體是如何盈利的?
用什麼軟體能畫出這樣的圖?

TAG:WolframMathematica |