Làm cách nào để lấy danh sách và tạo tất cả các danh sách có độ dài ngày càng tăng?

Question

Bất kỳ câu hỏi dễ dàng cho các chuyên gia Mathematica đây:

Cho một danh sách, nói

Clear[a, b, c]; 
data = {a, b, c}; 

và tôi muốn lấy lại tất cả danh sách dài 1,2,3,...Length[data] bắt đầu từ đầu đến cuối, vì vậy mà tôi có được sau đây cho ở trên

out = {{a}, {a, b}, {a, b, c}} 

tôi nhìn các lệnh trong M để tìm một sẵn sàng để sử dụng, và tôi có thể (xem xét tất cả các chức năng của Map và Nest *, nhưng không phải là tôi có thể thấy làm thế nào để sử dụng cho điều này). Tôi chắc chắn nó ở đó, nhưng tôi không thấy nó bây giờ.

bây giờ tôi Đỗ loop ngớ ngẩn này để xây dựng nó

m=Length[data]; 
First@Reap[Do[Sow[data[[1;;i]]],{i,1,m}]][[2]] 

{{a},{a,b},{a,b,c}} 

câu hỏi là: không Mathematica có build-in lệnh để làm các việc trên?

cập nhật 08:00

Tôi đã xóa các bài kiểm tra tôi đã thực hiện một giờ trước và sẽ được reposting họ lại sớm. Tôi cần phải chạy chúng vài lần và mất trung bình vì đó là cách tốt hơn để làm bài kiểm tra hiệu năng này.

cập nhật 09:00

Ok, tôi đã chạy lại kiểm tra hiệu suất trên tất cả các giải pháp hiển thị dưới đây. 8 phương pháp. Đối với mỗi phương pháp, tôi chạy nó 5 lần và lấy giá trị trung bình. Tôi đã làm điều này cho n={1000, 5000, 10000, 15000, 25000, 30000} trong đó n là độ dài của danh sách gốc để xử lý.

không thể vượt quá 30.000, sẽ hết RAM. Tôi chỉ có ram 4 GB.

Tôi đã tạo một hàm nhỏ gọi là makeTable[n, methods] tạo bảng hiệu suất cho n cụ thể. kiểm tra mã là dưới đây (viết một cách nhanh chóng vì vậy không phải là mã sạch nhất, không phải là rất chức năng, như tôi phải đi :), nhưng nó là dưới đây và bất kỳ ai có thể thay đổi/làm sạch nó, vv ... nếu họ muốn

kết luận: Phương pháp Kguler là nhanh nhất, với phương pháp Thies hầu như giống với n lớn, (30.000), vì vậy cho mọi mục đích thực tế, có thể là Phương pháp Thies và Kguler có thể được khai báo là người chiến thắng cho n lớn? Nhưng kể từ khi Kguler cũng là nhanh nhất cho n nhỏ, cho đến nay, ông được các cạnh rõ ràng.

Một lần nữa, mã kiểm tra dưới đây cho bất kỳ ai kiểm tra và chạy để xem tôi có thể mắc lỗi ở đâu đó không. Theo dự đoán chính xác của Leonid, phương pháp danh sách liên kết đã không quá tốt cho n lớn.

Tôi nghĩ rằng cần có nhiều thử nghiệm hơn, vì chỉ lấy trung bình của 5 có thể không đủ, những cân nhắc khác mà tôi có thể đã bỏ qua. Đây không phải là một thử nghiệm chính xác, chỉ là một thử nghiệm thô sơ để có được một ý tưởng.

Tôi đã cố gắng không sử dụng nhiều máy tính trong khi chạy thử nghiệm. Tôi đã sử dụng AbsoluteTiming [] để đo cpu.

Dưới đây là ảnh chụp màn hình của các bảng được tạo ra

Đây là mã kiểm tra:

methods = {nasser, wizard1, wizard2, wizard3, kguler, leonid1, 
    leonid2, thies}; 
AppendTo[$ContextPath, "Internal`"]; 
ClearAll[linkedList, leonid2]; 
SetAttributes[linkedList, HoldAllComplete]; 

nasser[lst_] := Module[{m = Length[lst]}, 
    First@Reap[Do[Sow[lst[[1 ;; i]]], {i, 1, m}]][[2]] 
    ]; 

wizard1[lst_] := Module[{}, 
    Take[lst, #] & /@ Range@Length@lst 
    ]; 

wizard2[lst_] := Module[{}, 
    Table[Take[#, i], {i, Length@#}] & @lst 
    ]; 

wizard3[lst_] := Module[{}, 
    Rest@FoldList[Append, {}, #] & @lst 
    ]; 

kguler[lst_] := Module[{}, 
    Reverse@NestList[Most, #, Length[#] - 1] & @lst 

    ]; 

leonid1[lst_] := Module[{b = Bag[{}]}, 
    Map[(StuffBag[b, #]; BagPart[b, All]) &, lst] 
    ]; 

leonid2[lst_] := Module[{}, 
    Map[List @@ Flatten[#, Infinity, linkedList] &, 
    FoldList[linkedList, linkedList[First@lst], Rest@lst]] 
    ]; 

thies[lst_] := 
    Module[{}, 
    Drop[Reverse@ 
    FixedPointList[If[Length[#] > 0, Most, Identity][#] &, lst], 2] 
    ]; 

makeTable[n_, methods_] := 
    Module[{nTests = Length[methods], nTries = 5, i, j, tests, lst}, 
    lst = Table[RandomReal[], {n}]; 

    tests = Table[0, {nTests}, {nTries}]; 

    For[i = 1, i <= nTests, i++, 
    For[j = 1, j <= nTries, j++, 
     tests[[i, j]] = First@AbsoluteTiming[methods[[i]][lst] ] 
    ] 
    ]; 

    tbl = Table[{ToString[methods[[i]]], Mean[ tests[[i, All]] ]}, {i, 
     nTests}] ; 

    Grid[Join[{{"method", "cpu"}}, tbl], 
    Frame -> All, FrameStyle -> Directive[Thickness[.005], Gray], 
    Spacings -> {0.5, 1} 
    ] 
    ]; 

Bây giờ để chạy, làm

makeTable[1000, methods] 

Cảnh báo, không thử một cái gì đó trên 30.000 trừ khi bạn có zillion GB, khác M có thể không trở về. Nó đã xảy ra với tôi, và phải khởi động lại PC.

cập nhật 12/26/11 3:30

Tôi thấy rằng Thies có một phiên bản mới hơn của thuật toán này (tôi gọi nó thies2 trong bảng phương pháp), vì vậy tôi lại chạy tất cả mọi thứ một lần nữa, đây là bảng được cập nhật, tôi đã xóa phiên bản danh sách được liên kết vì nó được biết trước không nhanh cho n lớn và lần này, tôi chạy chúng 10 lần (không phải 5 như trên) và sau đó lấy giá trị trung bình). Tôi cũng bắt đầu M sử dụng thiết lập nhà máy mới (khởi động lại nó giữ phím Alt-Shift để tất cả thiết lập đang trở lại các thiết lập ban đầu chỉ trong trường hợp)

kết luận cho đến nay

Kugler là nhanh nhất đối với n nhỏ hơn, tức là n < 20.000. Đối với lớn hơn n, bây giờ Thies phiên bản thứ hai là nhanh hơn so với phiên bản Thies 1 và bây giờ nó cạnh phía trước bao giờ nên hơi trước phương pháp Kugler cho n lớn. Xin chúc mừng đến Thies, người dẫn đầu hiện tại trong bài kiểm tra trình diễn này. Nhưng đối với tất cả các mục đích thực tế, tôi sẽ nói cả hai phương pháp Thies và Kugler là nhanh nhất cho n lớn, và Kugler vẫn là nhanh nhất cho n nhỏ hơn.

Dưới đây là các bảng và mã kiểm tra được cập nhật bên dưới chúng. Bất kỳ ai có thể tự do chạy thử nghiệm, chỉ trong trường hợp tôi có thể bỏ qua điều gì đó.

Các mã kiểm tra hiện tại:

$MinPrecision = $MachinePrecision; 
$MaxPrecision = $MachinePrecision; 
methods = {nasser, wizard1, wizard2, wizard3, kguler, leonid, thies1, 
    thies2}; 
AppendTo[$ContextPath, "Internal`"]; 

nasser[lst_] := Module[{m = Length[lst]}, 
    First@Reap[Do[Sow[lst[[1 ;; i]]], {i, 1, m}]][[2]] 
    ]; 

wizard1[lst_] := Module[{}, 
    Take[lst, #] & /@ Range@Length@lst 
    ]; 

wizard2[lst_] := Module[{}, 
    Table[Take[#, i], {i, Length@#}] & @lst 
    ]; 

wizard3[lst_] := Module[{}, 
    Rest@FoldList[Append, {}, #] & @lst 
    ]; 

kguler[lst_] := Module[{}, 
    Reverse@NestList[Most, #, Length[#] - 1] & @lst 

    ]; 

leonid[lst_] := Module[{b = Bag[{}]}, 
    Map[(StuffBag[b, #]; BagPart[b, All]) &, lst] 
    ]; 

thies1[lst_] := 
    Module[{}, 
    Drop[Reverse@ 
    FixedPointList[If[Length[#] > 0, Most, Identity][#] &, lst], 2] 
    ]; 

thies2[lst_] := 
    Module[{}, 
    Drop[Reverse@ 
    FixedPointList[If[# =!= {}, Most, Identity][#] &, lst], 2] 
    ]; 

makeTable[n_Integer, methods_List] := 
    Module[{nTests = Length[methods], nTries = 10, i, j, tests, lst}, 
    lst = Table[RandomReal[], {n}]; 

    tests = Table[0, {nTests}, {nTries}]; 

    For[i = 1, i <= nTests, i++, 
    For[j = 1, j <= nTries, j++, 
     tests[[i, j]] = First@AbsoluteTiming[methods[[i]][lst] ] 
    ] 
    ]; 

    tbl = Table[{ToString[methods[[i]]], Mean[ tests[[i, All]] ]}, {i, 
     nTests}] ; 

    Grid[Join[{{"method", "cpu"}}, tbl], 
    Frame -> All, FrameStyle -> Directive[Thickness[.005], Gray], 
    Spacings -> {0.5, 1} 
    ] 
    ]; 

Để chạy loại

n=1000 
makeTable[n, methods] 

Cảm ơn for everyone cho câu trả lời của họ, tôi học được từ tất cả chúng.

Answer 1

Một ý tưởng:

Inits[l_] := Drop[Reverse@FixedPointList[ 
       If[Length[#] > 0, Most, Identity][#] &, 
       l 
      ], 2]; 

Cập nhật:

Phiên bản này là một chút nhanh hơn bằng cách bỏ qua tính toán chiều dài mỗi lần:

Inits2[l_] := Drop[Reverse@FixedPointList[ 
       If[# =!= {}, Most, Identity][#] &, 
       l 
       ], 2]; 

Answer 2

Bạn có thể sử dụng

f = Reverse@NestList[Most, #, Length[#] - 1] & 

f@{a,b,c,d,e} cho {{a}, {a, b}, {a, b, c}, {a, b, c, d}, {a, b, c, d, e}}.

Cách thay thế bằng cách sử dụng ReplaceList - chậm hơn nhiều so với f, nhưng ... tại sao lại không?:

g = ReplaceList[#, {x__, ___} -> {x}] & 

Answer 3

Tôi đề nghị này:

runs[lst_] := Take[lst, #] & /@ Range@Length@lst 

Hoặc này:

runs2 = Table[Take[#, i], {i, Length@#}] &; 

---

câu trả lời kguler của cảm hứng cho tôi viết này:

Rest@FoldList[Append, {}, #] & 

Nhưng điều này là chậm hơn so với phương pháp của mình vì Mathematica của phụ thêm chậm.

Answer 4

Dưới đây là một phương pháp đó là xấp xỉ như hiệu quả như là một sự tham gia của Take, nhưng sử dụng các chức năng Internal`Bag:

AppendTo[$ContextPath, "Internal`"]; 
runsB[lst_] := 
    Module[{b = Bag[{}]}, Map[(StuffBag[b, #]; BagPart[b, All]) &, lst]]; 

tôi không cho rằng nó là đơn giản hơn so với cái dựa trên Take, nhưng nó dường như là một ví dụ đơn giản của Internal`Bag tại nơi làm việc - vì đây chính xác là loại vấn đề mà chúng có thể được sử dụng thành công (và có thể có trường hợp danh sách vị trí rõ ràng hoặc không có sẵn để tính toán).

Chỉ cần so sánh, các giải pháp dựa trên danh sách liên kết:

ClearAll[linkedList, runsLL]; 
SetAttributes[linkedList, HoldAllComplete]; 
runsLL[lst_] := 
    Map[List @@ Flatten[#, Infinity, linkedList] &, 
    FoldList[linkedList, linkedList[First@lst], Rest@lst]] 

sẽ là một thứ tự cường độ chậm hơn trên các danh sách lớn.

Answer 5

Có lẽ không phải là hiệu quả nhất, nhưng cách tiếp cận khác:

dow[lst_] := lst[[1 ;; #]] & /@ Range@Length@lst 

Ví dụ:

dow[{a, b, c, d, ee}] 

cho:

{{a}, {a, b}, {a, b, c}, {a, b, c, d} , {a, b, c, d, ee}}