โซ่ Gozinta

(แรงบันดาลใจจากProject Euler # 606 )

ห่วงโซ่ gozinta สำหรับ n เป็นลำดับ{1,a,b,...,n}ที่แต่ละองค์ประกอบแบ่งอย่างถูกต้องต่อไป ตัวอย่างเช่นมีแปด gozinta โซ่ที่แตกต่างกันสำหรับ 12:

{1,12}, {1,2,12}, {1,2,4,12}, {1,2,6,12}, {1,3,12}, {1,3,6,12}, {1,4,12} and {1,6,12}.

ความท้าทาย

เขียนโปรแกรมหรือฟังก์ชั่นที่รับจำนวนเต็มบวก ( n > 1) และเอาท์พุทหรือส่งกลับค่าเชน gozinta ที่แตกต่างกันทั้งหมดสำหรับจำนวนที่กำหนด

1. สั่งในเรื่องโซ่ (น้อยไปหามาก), คำสั่งของโซ่ไม่ได้
2. เมื่อมีโอกาสคุณจะไม่สามารถใช้ builtin ที่สามารถแก้ปัญหาได้
3. นี่คือรหัสกอล์ฟ

แก้ไข: การลบ1เป็นอินพุตที่มีศักยภาพ

Python 3 , 68 65 ไบต์

แก้ไข: -3 ไบต์ขอบคุณ@notjagan

f=lambda x:[y+[x]for k in range(1,x)if x%k<1for y in f(k)]or[[x]]

ลองออนไลน์!

คำอธิบาย

ห่วงโซ่ gozintaแต่ละอันประกอบด้วยหมายเลขxที่ส่วนท้ายของห่วงโซ่โดยมีตัวหารอย่างน้อยหนึ่งตัวทางด้านซ้าย สำหรับตัวหารkของxโซ่แต่ละอัน[1,...,k,x]นั้นแตกต่างกัน เราจึงสามารถสำหรับแต่ละหารkทั้งหมดที่แตกต่างโซ่ gozinta และผนวกxไปยังจุดสิ้นสุดของพวกเขาจะได้รับทั้งหมดที่แตกต่างกันโซ่ gozintaกับโดยตรงที่ด้านซ้ายของk xนี้จะทำซ้ำจนกว่าx = 1ที่[[1]]จะถูกส่งกลับเป็นทั้งหมดโซ่ gozintaเริ่มต้นด้วย 1 หมายถึงการเรียกซ้ำได้ผ่านจุดต่ำสุด

รหัสสั้นมากเนื่องจากความเข้าใจในรายการ Python ที่อนุญาตให้วนซ้ำซ้ำได้ ซึ่งหมายความว่าค่าที่พบในf(k)สามารถเพิ่มลงในรายการเดียวกันสำหรับตัวหารที่แตกต่างกันkทั้งหมด

Husk , 13 ไบต์

ufo=ḣ⁰…ġ¦ΣṖḣ⁰

วิธีการที่แตกต่างไปจากH.PWizแม้ว่าจะยังคงอยู่โดยใช้กำลังดุร้าย ลองออนไลน์!

คำอธิบาย

แนวคิดพื้นฐานคือการเชื่อมต่อทุกส่วนของ[1,...,n]และแยกผลลัพธ์ออกเป็นรายการย่อยที่แต่ละองค์ประกอบหารถัดไป ของเหล่านี้เราให้ผู้ที่เริ่มต้นด้วย1สิ้นสุดnและไม่มีรายการที่ซ้ำกัน สิ่งนี้ทำด้วย "rangify" ใน…ตัว จากนั้นยังคงทิ้งการทำซ้ำ

ufo=ḣ⁰…ġ¦ΣṖḣ⁰  Input is n=12.
           ḣ⁰  Range from 1: [1,2,..,12]
          Ṗ    Powerset: [[],[1],[2],[1,2],[3],..,[1,2,..,12]]
         Σ     Concatenate: [1,2,1,2,3,..,1,2,..,12]
       ġ¦      Split into slices where each number divides next: [[1,2],[1,2],[3],..,[12]]
 fo            Filter by
      …        rangified
   =ḣ⁰         equals [1,...,n].
u              Remove duplicates.

เยลลี่ , 9 8 ไบต์

ÆḌ߀Ẏ;€ȯ

ลองออนไลน์!

ใช้เทคนิคที่คล้ายกันกับคำตอบ Japtของฉันและดังนั้นจึงทำงานได้อย่างรวดเร็วในกรณีทดสอบขนาดใหญ่

มันทำงานอย่างไร

ÆḌ߀Ẏ;€ȯ    Main link. Argument: n (integer)
ÆḌ          Yield the proper divisors of n.
       ȯ    If there are no divisors, return n. Only happens when n is 1.
  ߀        Otherwise, run each divisor through this link again. Yields
            a list of lists of Gozinta chains.
    Ẏ       Tighten; bring each chain into the main list.
     ;€     Append n to each chain.

Mathematica, 77 ไบต์

FindPath[Graph@Cases[Divisors@#~Subsets~{2},{m_,n_}/;m∣n:>m->n],1,#,#,All]&

รูปแบบGraphที่จุดเป็นDivisorsของอินพุต#และขอบแทนหารที่เหมาะสมแล้วก็พบว่าAllเส้นทางจากจุดสุดยอดที่จะจุดสุดยอด1#

เยลลี่ 12 ไบต์

ŒPµḍ2\×ISµÐṀ

ลิงก์ monadic ยอมรับจำนวนเต็มและส่งคืนรายการของจำนวนเต็ม

ลองออนไลน์!

อย่างไร?

เราต้องการรายการที่เรียงลำดับทั้งหมดของจำนวนเต็มที่ไม่ซ้ำกันระหว่างหนึ่งและ N ดังกล่าวที่แรกคือหนึ่งที่ผ่านมาคือ N และทุกคู่แบ่ง รหัสบรรลุตัวกรองนี้โดยการตรวจสอบเกณฑ์การแบ่งคู่ที่ชาญฉลาดเป็นที่พอใจมากกว่าชุดกำลังของช่วงที่มีปัญหา แต่จะเลือกเฉพาะส่วนที่มีจำนวนผลต่างที่เพิ่มขึ้นสูงสุดเท่านั้น (ตัวที่เริ่มต้นด้วยหนึ่งและจบด้วย N ผลรวมของความแตกต่างที่เพิ่มขึ้นของ N-1 อื่น ๆ จะมีน้อยกว่า)

ŒPµḍ2\×ISµÐṀ - Link: number N
ŒP           - power-set (implicit range of input) = [[1],[2],...,[N],[1,2],[1,3],...,[1,N],[1,2,3],...]
          ÐṀ - filter keep those for which the result of the link to the left is maximal:
  µ      µ   - (a monadic chain)
    2\       -   pairwise overlapping reduce with:
   ḍ         -     divides? (1 if so, 0 otherwise)
       I     -   increments  e.g. for [1,2,4,12] -> [2-1,4-2,12-4] = [1,2,8]
      ×      -   multiply (vectorises) (no effect if all divide,
             -                          otherwise at least one gets set to 0)
        S    -   sum         e.g. for [1,2,4,12] -> 1+2+8 = 11 (=12-1)

Japt , 17 ไบต์

⬣ßX m+S+UR÷ª'1

ทดสอบออนไลน์!

แปลกที่การสร้างเอาต์พุตเป็นสตริงนั้นง่ายกว่าการสร้างเป็นอาร์เรย์ของ ...

คำอธิบาย

 ⬠£  ßX m+S+URà ·  ª '1
Uâq mX{ßX m+S+UR} qR ||'1   Ungolfed
                            Implicit: U = input number, R = newline, S = space
Uâ                          Find all divisors of U,
  q                           leaving out U itself.
    mX{         }           Map each divisor X to
       ßX                     The divisor chains of X (literally "run the program on X")
          m    R              with each chain mapped to
           +S+U                 the chain, plus a space, plus U.
                  qR        Join on newlines.
                     ||     If the result is empty (only happens when there are no factors, i.e. U == 1)
                       '1     return the string "1".
                            Otherwise, return the generated string.
                            Implicit: output result of last expression

Mathematica, 60 ไบต์

Cases[Subsets@Divisors@#,x:{1,___,#}/;Divisible@@Reverse@{x}]&

ใช้รูปแบบที่ไม่มีเอกสารหลายหาเรื่องของการDivisibleที่Divisible[n1,n2,...]ผลตอบแทนTrueถ้าn2∣n1, n3∣n2และอื่น ๆ และFalseอย่างอื่น เราใช้เวลาทั้งหมดSubsetsของรายการของDivisorsของท่าน#แล้วกลับมาCasesในรูปแบบ{1,___,#}ดังกล่าวที่Divisibleให้TrueสำหรับReversed ลำดับของตัวหาร

Haskell, 51 ไบต์

f 1=[[1]]
f n=[g++[n]|k<-[1..n-1],n`mod`k<1,g<-f k]

ซ้ำพบโซ่ gozinta nของตัวหารที่เหมาะสมและการผนวก

ลองออนไลน์!

Haskell (แลมบ์บ็อต), 92 85 ไบต์

x#y|x==y=[[x]]|1>0=(guard(mod x y<1)>>(y:).map(y*)<$>div x y#2)++x#(y+1)
map(1:).(#2)

ต้องการ Lambdabot Haskell ตั้งแต่guardต้องControl.Monadนำเข้า ฟังก์ชั่นหลักคือฟังก์ชั่นนิรนามซึ่งฉันบอกว่าได้รับอนุญาต

ขอบคุณ Laikoni สำหรับการบันทึกเจ็ดไบต์

คำอธิบาย:

พระมีประโยชน์มาก

x # y

นี่คือฟังก์ชั่นวนซ้ำของเราที่ทำงานได้จริงทั้งหมด xคือจำนวนที่เรากำลังสะสม (ผลคูณของตัวหารที่ยังคงอยู่ในค่า) และyเป็นจำนวนถัดไปที่เราควรลองหารมัน

 | x == y = [[x]]

ถ้าxเท่ากับyเราจะทำการเรียกซ้ำ เพียงใช้xเป็นจุดสิ้นสุดของห่วงโซ่ gozinta ปัจจุบันและส่งคืน

 | 1 > 0 =

Haskell golf-ism สำหรับ "True" นั่นคือกรณีนี้เป็นค่าเริ่มต้น

(guard (mod x y < 1) >>

เรากำลังดำเนินการภายในรายการ monad ในขณะนี้ ภายในรายการ monad เรามีความสามารถในการเลือกหลายอย่างในเวลาเดียวกัน สิ่งนี้มีประโยชน์มากเมื่อค้นหา "สิ่งที่เป็นไปได้" ของบางสิ่งด้วยความอ่อนเพลีย guardคำสั่งว่า "จะพิจารณาทางเลือกต่อไปนี้หากสภาพที่เป็นจริง" ในกรณีนี้จะพิจารณาทางเลือกต่อไปนี้หากแบ่งyx

(y:) . map (y *) <$> div x y#2)

ถ้าyแบ่งxเรามีทางเลือกในการเพิ่มyเข้าไปในห่วงโซ่ gozinta ในกรณีนี้โทรซ้ำ(#)เริ่มต้นy = 2ด้วยxเท่ากับx / yเพราะเราต้องการ "แยกตัวประกอบ" ที่yเราเพิ่งเพิ่มเข้าไปในห่วงโซ่ จากนั้นไม่ว่าผลที่ได้จากการโทรแบบเรียกซ้ำนี้จะมีหลายค่าโดยyเราเพิ่งแยกตัวประกอบและเพิ่มyเข้าไปในห่วงโซ่ gozinta อย่างเป็นทางการ

++

พิจารณาตัวเลือกต่อไปนี้เช่นกัน นี่เป็นการรวมสองรายการเข้าด้วยกัน แต่เราสามารถคิดได้ว่าเป็นการพูดแบบ "เลือกระหว่างการทำสิ่งนี้หรือสิ่งอื่น ๆ "

x # (y + 1)

ตัวเลือกอื่น ๆ ก็คือการดำเนินการต่อ recursing yและไม่ใช้ค่า ถ้าyไม่แบ่งxนี่เป็นตัวเลือกเดียว ถ้าyแบ่งxแล้วตัวเลือกนี้จะถูกนำมาเป็นตัวเลือกอื่น ๆ และผลลัพธ์จะรวมกัน

map (1 :) . (# 2)

นี่คือฟังก์ชั่นหลักของ gozinta มันเริ่มต้นการสอบถามซ้ำโดยการเรียก(#)ด้วยการโต้แย้ง A 1ถูกเติมลงในทุก ๆ gozinta chain เนื่องจาก(#)ฟังก์ชั่นไม่เคยใส่เข้าไปใน chain

Haskell, 107 100 95 ไบต์

f n=until(all(<2).map head)(>>=h)[[n]]
h l@(x:_)|x<2=[l]|1<2=map(:l)$filter((<1).mod x)[1..x-1]

อาจจะมีเงื่อนไขการเลิกจ้างที่ดีกว่า (ลองทำสิ่งที่ชอบ

f n=i[[n]]
i x|g x==x=x|1<2=i$g x
g=(>>=h)

แต่มันก็นานกว่า) 1ดูเหมือนว่าการตรวจสอบอย่างรอบคอบนั้นจะเป็นการตรวจสอบซ้ำ1ๆ หรือทำซ้ำ ( nubไม่ใช่ในPrelude) มากกว่าไบต์

ลองออนไลน์

JavaScript (Firefox 30-57), 73 ไบต์

f=n=>n>1?[for(i of Array(n).keys())if(n%i<1)for(j of f(i))[...j,n]]:[[1]]

สะดวกn%0<1เป็นเท็จ

เยลลี่ขนาด 17 ไบต์

ḊṖŒP1ppWF€ḍ2\Ạ$Ðf

ลองออนไลน์!

Mathematica, 104 ไบต์

(S=Select)[Rest@S[Subsets@Divisors[t=#],FreeQ[#∣#2&@@@Partition[#,2,1],1>2]&],First@#==1&&Last@#==t&]&

Mathematica ขนาด 72 ไบต์

Cases[Subsets@Divisors@#,{1,___,#}?(And@@BlockMap[#∣#2&@@#&,#,2,1]&)]&

คำอธิบาย

Divisors@#

ค้นหาตัวหารทั้งหมดของอินพุต

Subsets@ ...

สร้างชุดย่อยทั้งหมดของรายการนั้น

Cases[ ... ]

เลือกทุกกรณีที่ตรงกับรูปแบบ ...

{1,___,#}

เริ่มต้นด้วย 1 และลงท้ายด้วย<input>...

?( ... )

และตรงตามเงื่อนไข ...

And@@BlockMap[#∣#2&@@#&,#,2,1]&

องค์ประกอบด้านซ้ายแบ่งองค์ประกอบที่เหมาะสมสำหรับ 2 พาร์ติชันทั้งหมดของรายการออฟเซ็ต 1

TI-BASIC, 76 ไบต์

Input N
1→L1(1
Repeat Ans=2
While Ans<N
2Ans→L1(1+dim(L1
End
If Ans=N:Disp L1
dim(L1)-1→dim(L1
L1(Ans)+L1(Ans-(Ans>1→L1(Ans
End

คำอธิบาย

Input N                       Prompt user for N.
1→L1(1                        Initialize L1 to {1}, and also set Ans to 1.

Repeat Ans=2                  Loop until Ans is 2.
                              At this point in the loop, Ans holds the
                              last element of L1.

While Ans<N                   While the last element is less than N,
2Ans→L1(1+dim(L1              extend the list with twice that value.
End

If Ans=N:Disp L1              If the last element is N, display the list.

dim(L1)-1→dim(L1              Remove the last element, and place the new
                              list size in Ans.

L1(Ans)+L1(Ans-(Ans>1→L1(Ans  Add the second-to-last element to the last
                              element, thereby advancing to the next
                              multiple of the second-to-last element.
                              Avoid erroring when only one element remains
                              by adding the last element to itself.

End                           When the 1 is added to itself, stop looping.

ฉันสามารถบันทึกอีก 5 ไบต์ได้หากได้รับอนุญาตให้ออกโดยมีข้อผิดพลาดแทนการใช้อย่างสง่างามโดยลบ Ans> 1 check และเงื่อนไขลูปออก แต่ฉันไม่มั่นใจว่าได้รับอนุญาต

Mathematica 86 77 ไบต์

Select[Subsets@Divisors@#~Cases~{1,___,#},And@@BlockMap[#∣#2&@@#&,#,2,1]&]&

กำลังดุร้ายตามนิยาม

หวังว่าจะมีวิธีที่สั้นกว่าในการทำการเปรียบเทียบองค์ประกอบตามลำดับของรายการ

ขอบคุณ @Jenny_mathy และ @JungHwanMin สำหรับคำแนะนำที่ประหยัดได้ 9 ไบต์

Husk , 17 16 ไบต์

-1 ไบต์ขอบคุณ Zgarb

foEẊ¦m`Je1⁰Ṗthḣ⁰

ลองออนไลน์!

PHP 147 141

แก้ไขเพื่อลบการทดสอบซ้ำซ้อน

function g($i){$r=[[1]];for($j=2;$j<=$i;$j++)foreach($r as$c)if($j%end($c)<1&&$c[]=$j)$r[]=$c;foreach($r as$c)end($c)<$i?0:$R[]=$c;return$R;}

อธิบาย:

function g($i) {

15 chars of boilerplate :(

    $r = [[1]];

[[1]]เริ่มต้นชุดผลลัพธ์เป็นทุกเชนเริ่มต้นด้วย 1 ซึ่งจะนำไปสู่การสนับสนุนสำหรับ 1 เป็นอินพุต

    for ($j = 2; $j <= $i; $j++) {
        foreach ($r as $c) {
            if ($j % end($c) < 1) {
                $c[] = $j;
                $r[] = $c;
            }
        }
    }

สำหรับทุก ๆ เลขตั้งแต่ 2 ถึง$iเราจะขยายแต่ละ chain ในเซตของเราด้วยหมายเลขปัจจุบันถ้ามันเป็นgozintaจากนั้นเพิ่ม chain ที่ขยายเข้าไปในเซตผลลัพธ์ของเรา

    foreach ($r as $c) {
        end($c) < $i ? 0 : $R[] = $c;
    }

กรองโซ่กลางของเราที่ไม่ได้ทำ $i

    return $R;
}

10 chars ของสำเร็จรูป :(

มาติกา

f[1] = {{1}};
f[n_] := f[n] = Append[n] /@ Apply[Join, Map[f, Most@Divisors@n]]

คำตอบถูกแคชสำหรับการโทรเพิ่มเติม