वोल्फ्राम मैथेमेटिका में जापानी क्रॉसवर्ड को हल करना

जापानी क्रॉसवर्ड एक प्रसिद्ध पहेली है जिसका उत्तर ड्राइंग है। यह क्या है और इसे कैसे हल किया जाए, आप विकिपीडिया पर पढ़ सकते हैं। मैं यह दिखाना चाहता हूं कि आप एक कार्यक्रम कैसे लिख सकते हैं जो एक जापानी पहेली पहेली को वुल्फराम मैथमेटिका में गणना द्वारा हल करेगा।

मुख्य विचार

ब्रूट फोर्स सॉल्यूशन का विचार सभी पंक्तियों और स्तंभों के लिए सभी संभावित सेल स्थानों की सूची बनाना है। उसके बाद, प्राप्त सूचियों का उपयोग करके, उन कोशिकाओं को खोजें जिनकी जानकारी सही रूप से ज्ञात होगी। फिर हमने ऐसे स्थानों को खोजा जो जानकारी मिली के विपरीत है। सहज रूप से, यदि आप पिछले दो प्रक्रियाओं को चक्रीय रूप से दोहराते हैं, तो आप किसी भी सेल के बारे में जानकारी पा सकते हैं। इसलिए, कार्य को तीन उप-प्रकारों में विभाजित किया जा सकता है:

1. सभी संभावित स्थानों का संकलन।
2. भरी हुई और अधूरी कोशिकाओं की खोज करें।
3. परस्पर विरोधी स्थानों को हटाना।

चूंकि वुल्फ्राम मैथमेटिका को सूचियों के साथ काम करने के लिए बनाया गया था , इसलिए सेल स्थानों को कार्यक्रम में सूचियों के रूप में संग्रहीत किया जाएगा। हम निम्नानुसार कोशिकाओं के बारे में जानकारी निरूपित करेंगे:

• 1 - भरा हुआ सेल;
• 0 - अनफ़िल्ड सेल;
• * - एक सेल जिसके बारे में कुछ भी पता नहीं है।

उदाहरण के लिए, नीचे कोशिकाओं की समकक्ष सूची और व्यवस्था दिखाई गई है:

सभी संभावित स्थानों का संकलन

सिद्धांत की बिट

एक विशिष्ट उदाहरण पर विचार करें। ऐसे डेटा के लिए सभी प्रकार के स्थान ढूंढना आवश्यक है:

इनमें से एक स्थान ऊपर दिखाया गया है। सभी संभावित स्थानों से कैसे छाँटें?

चलो इसे अगले तरीके से करते हैं। आइए हम कक्षों के निम्नलिखित समूहों को कुंजी (फ़ील्ड के बाईं ओर स्थित): {{1,0}, {1,1,0}, {1,1,1}} । अब एक सूची बनाएं जो उन स्थानों को संग्रहीत करेगा जहां हम इन समूहों को व्यवस्थित करेंगे। उन स्थानों पर जहां हम इन समूहों को रखेंगे, हम शून्य स्टोर करेंगे। इस प्रकार, हमें स्थानों की एक सूची मिलती है {0,0,0,0,0} । प्राप्त स्थानों में सभी साधनों के क्रम में कोशिकाओं के समूहों की व्यवस्था करना, यह सत्यापित करना आसान है कि हम कार्य से डेटा के लिए सभी आवश्यक व्यवस्थाएं प्राप्त करते हैं। यदि आप समूहों को क्रमांक 1, 3, 4 के स्थानों में रखते हैं, तो आपको ऊपर दिए गए उदाहरण से व्यवस्था मिल जाएगी। इस प्रकार, यह पता चला है कि सभी स्थान समूहों की संख्या में स्थानों की संख्या के संयोजन के बराबर हैं। समूहों को रखने के लिए किसी तरह से स्थानों को चुनना, हमें संभावित स्थानों में से एक मिलता है। उदाहरण से डेटा के लिए, स्थानों की संख्या दस है।

प्रश्नों के लिए "अंतिम समूह में कोई शून्य क्यों नहीं है?" और "आखिरकार पांच सीटें क्यों हैं?" जागरूक पाठक को खुद जवाब देना चाहिए।

कार्यान्वयन

यह स्पष्ट है कि फ़ंक्शन को लिखने की कोई ख़ास इच्छा नहीं है, जो कि बहुत ही Subsets[list, {n}] हो, क्योंकि मैथेमेटिका में एक बिल्ट-इन फ़ंक्शन Subsets[list, {n}] जो ऐसा करेगा। यह सूची list को तत्वों के एक सेट के रूप में और संख्या n को मापदंडों के रूप में लेता है और लंबाई n की सेट list सबसेट की सूची देता है। हमारे उदाहरण के लिए, सभी स्थानों पर इसे पुनरावृत्त करने के लिए इसका उपयोग इस तरह होगा:

In := Subsets[{1,2,3,4,5}, {3}]

Out = {{1,2,3}, {1,2,4}, {1,2,5}, {1,3,4}, {1,3,5}, {1,4,5}, {2,3,4}, {2,3,5}, {2,4,5}, {3,4,5}}


अब हम अपना स्वयं का फ़ंक्शन लिखेंगे, जो एक संख्या लेगा (उदाहरण के डेटा के लिए फ़ील्ड की लंबाई - 10 ) और एक सूची ( clue कुंजी, उदाहरण के डेटा के लिए - {1,2,3} ) मापदंडों के रूप में और सभी संभावित स्थानों की सूची लौटाएं। हम सब कुछ क्रमिक रूप से करेंगे। सबसे पहले, एक फ़ंक्शन बनाएं जो एक संख्या को इकाइयों की सूची में बदल देता है। एक अंतर्निहित फ़ंक्शन ConstantArray[c, n] ; c वह तत्व है जो सूची को पॉप्युलेट करता है, और n इस सूची की लंबाई है।

In := ConstantArray[1, 2]

Out = {1, 1}


इसके बाद, हमें इस सूची के अंत में शून्य संलग्न करना होगा। यह Append[expr, elem] का उपयोग करके किया जाता है। पहला पैरामीटर एक सूची है, दूसरा वह है जो हम संलग्न करेंगे।

In := Append[{1, 1}, 0]

Out = {1, 1, 0}


हम इन दो कार्यों को एक शुद्ध फ़ंक्शन जैसे ऑब्जेक्ट का उपयोग करके एक में इकट्ठा करते हैं। इसे दो तरीकों से किया जा सकता है: Function[arg, Append[ConstantArray[1, arg], 0] , या इससे कम, Append[ConstantArray[1, #], 0]& ।

अब यह इस फ़ंक्शन को सूची के प्रत्येक तत्व पर लागू करना बाकी है जो कुंजी से मेल खाती है। इसके लिए एक बहुत उपयोगी Map[f, expr] फ़ंक्शन है। यह expr सूची के प्रत्येक तत्व के लिए फंक्शन को लागू करता है। उसके पास एक छोटा विकल्प भी है: f /@ expr ।

In := Append[ConstantArray[1, #], 0]& /@ {1, 2, 3}

Out = {{1,0}, {1,1,0}, {1,1,1,0}}


यह केवल अंतिम समूह से शून्य निकालने के लिए बनी हुई है। यहां Delete[expr, {i, j}] फंक्शन मदद करेगा। यह इंडेक्स {i, j} साथ expr सूची से आइटम को हटा देगा। यह मत भूलो कि अंतिम तत्व में -1 का सूचकांक है।

In := Delete[{{1,0}, {1,1,0}, {1,1,1,0}}, {-1, -1}]

Out = {{1,0}, {1,1,0}, {1,1,1}}


सभी एक साथ इस तरह दिखता है:

In := groups = Delete[Append[ConstantArray[1, #], 0]& /@ clue, {-1, -1}]

Out = {{1,0}, {1,1,0}, {1,1,1}}


स्थानों की सूची के साथ सब कुछ स्पष्ट है, लेकिन हमें Total[list] फ़ंक्शन की आवश्यकता होगी, जो सूची list के तत्वों को सारांशित करता है।

In := positions = ConstantArray[0, len - Total[clue] + 1]

Out = {0,0,0,0,0}


अब सबसे महत्वपूर्ण बात Subsets फ़ंक्शन का उपयोग करना है। साथ ही, हमें Range[n] फ़ंक्शन की आवश्यकता है, जो सूची {1, 2, ..., n} और Length[list] लौटाता है, जो सूची की लंबाई देता है।

In := sub = Subsets[Range[len - Total[clue] + 1], {Length[clue]}]

Out = {{1,2,3}, {1,2,4}, {1,2,5}, {1,3,4}, {1,3,5}, {1,4,5}, {2,3,4}, {2,3,5}, {2,4,5}, {3,4,5}}


हमें कोशिकाओं के समूहों को व्यवस्थित करने के लिए स्थानों की एक सूची मिली। अब हम व्यवस्था से निपटेंगे। ऐसा करने के लिए, हमें ReplacePart[expr, i->new] फ़ंक्शन की आवश्यकता है, यह तत्व को new तत्व के साथ expr सूची में नंबर i साथ बदल देता है। लेकिन पहले, हमें प्रतिस्थापन की एक सूची मिलती है, ताकि बाद में कोड लिखना अधिक सुविधाजनक हो। MapThread[f, {a फ़ंक्शन MapThread[f, {a ₁ , a ₂ , ...}, {b ₁ , b ₂ , ...}] हमें ऐसा करने में मदद करेगा। इसके कार्यान्वयन का परिणाम निम्नानुसार होगा: {f[a ₁ , b ₁ ], f[a ₂ , b ₂ ], ...} । इसलिए, प्रतिस्थापन की एक सूची बनाएं:

In := rep = MapThread[Function[{x, y}, x->y], {#, groups}]& /@ sub

Out = {{1->{1,0}, 2->{1,1,0}, 3->{1,1,1}}, {1->{1,0}, 2->{1,1,0}, 4->{1,1,1}}, {1->{1,0}, 2->{1,1,0}, 5->{1,1,1}}, {1->{1,0}, 3->{1,1,0}, 4->{1,1,1}}, {1->{1,0}, 3->{1,1,0}, 5->{1,1,1}}, {1->{1,0}, 4->{1,1,0}, 5->{1,1,1}}, {2->{1,0}, 3->{1,1,0}, 4->{1,1,1}}, {2->{1,0}, 3->{1,1,0}, 5->{1,1,1}}, {2->{1,0}, 4->{1,1,0}, 5->{1,1,1}}, {3->{1,0}, 4->{1,1,0}, 5->{1,1,1}}}


पूरे उपक्रम का समापन अपने स्थान पर एक व्यवस्था है। यहाँ हम Flatten[list] , जो अतिरिक्त कोष्ठक हटाता है:

In := all = Flatten[ReplacePart[positions, #]]& /@ rep

Out = {{1,0,1,1,0,1,1,1,0,0}, {1,0,1,1,0,0,1,1,1,0}, {1,0,1,1,0,0,0,1,1,1}, {1,0,0,1,1,0,1,1,1,0}, {1,0,0,1,1,0,0,1,1,1}, {1,0,0,0,1,1,0,1,1,1}, {0,1,0,1,1,0,1,1,1,0}, {0,1,0,1,1,0,0,1,1,1}, {0,1,0,0,1,1,0,1,1,1}, {0,0,1,0,1,1,0,1,1,1}}


वह सब, सभी नक्षत्र प्राप्त हैं। यह सुविधा के लिए एक मॉड्यूल में इन सभी को संयोजित करने के लिए रहता है और हमें आवश्यक फ़ंक्शन मिलेगा।

allPositions[len_, clue_] :=

Module[{groups, positions, sub, rep, all},

groups = Delete[Append[ConstantArray[1, #], 0]& /@ clue, {-1, -1}];

positions = ConstantArray[0, len - Total[clue] + 1];

sub = Subsets[Range[len - Total[clue] + 1], {Length[clue]}];

rep = MapThread[Function[{x, y}, x->y], {#, groups}]& /@ sub;

all = Flatten[ReplacePart[positions, #]]& /@ rep;

Return[all];]


भरी हुई और अधूरी कोशिकाओं की खोज करें

अब, इस सभी अच्छे के बीच जो हम अपने कार्य का उपयोग कर रहे हैं, हमें कोशिकाओं के बारे में जानकारी निकालने की आवश्यकता है। मान लीजिए हमारे पास कुछ स्थानों की सूची है। यदि कोई ऐसा स्थान है जहां सभी स्थानों में 1 या 0 है, तो यह हमें यह दावा करने का अधिकार देता है कि इस स्थिति में हमेशा भरा हुआ या क्रमशः, अनफ़िल्ड सेल होगा। मेरी राय में, ऐसा करने वाले फ़ंक्शन का सरलतम कार्यान्वयन निम्नानुसार है: सभी स्थानों को तत्व द्वारा संक्षेपित किया गया है और या तो सभी स्थानों या शून्य की संख्या के बराबर संख्या परिणामी सूची में खोजी गई हैं। पहले मामले में, ये संख्या इकाइयों में बदल जाती है, और दूसरे में, शून्य अपने स्थानों पर बने रहते हैं। अन्य सभी तत्वों को तारांकन के साथ बदल दिया जाता है। कार्यान्वयन के लिए, हम ReplaceAll[list, rule] फ़ंक्शन का उपयोग करेंगे। यह नियमों के साथ list में वस्तुओं को प्रतिस्थापित करेगा। निर्माण x_ /; x!=0 x_ /; x!=0 अर्थ है "एक तत्व x ऐसा कि x ≠ 0 । x ≠ 0 "।

findInformation[list_] := ReplaceAll[Total[list], {x_ /; x!=0 && x!=Length[list] -> "*", x_ /; x==Length[list] -> 1}]

हमारे उदाहरण के लिए, फ़ंक्शन इस तरह काम करता है:

In := findInformation[allPositions[len, clue]]

Out = {*,*,*,*,*,*,*,1,*,*}


सभी स्थानों में आठवें सेल को छायांकित किया जाएगा, इसलिए पूरे ग्रिड में इसे छायांकित किया जाएगा। शेष कोशिकाओं के बारे में कुछ नहीं कहा जा सकता है।

परस्पर विरोधी स्थानों को हटाना

प्राप्त जानकारी का उपयोग उन स्थानों को फ़िल्टर करने के लिए किया जा सकता है जो इसके विपरीत हैं। DeleteCases[expr, pattern] फ़ंक्शन हमारा फ़िल्टर होगा - यह expr सूची से उन सभी तत्वों को हटा देता है जो pattern मेल नहीं खाते हैं। Except[c] फ़ंक्शन का भी उपयोग किया जाएगा, जो अपने पैरामीटर को छोड़कर सब कुछ का चयन करता है।

deleteFromList[list_, test_] := DeleteCases[list, Except[ReplaceAll[test, "*"->_]]]


आइए उदाहरण पर वापस जाएं, हमें बताएं कि कोशिकाओं की व्यवस्था को इस तरह के पैटर्न को संतुष्ट करना होगा: {*,*,0,0,*,1,0,*,*,*} । हमारे समारोह चल रहा है, हम:

In := deleteFromList[allPositions[len, clue], {"*","*",0,0,"*",1,0,"*","*","*"}]

Out = {{1,0,0,0,1,1,0,1,1,1}, {0,1,0,0,1,1,0,1,1,1}}


यह पता चला कि दस स्थानों में से केवल दो ही पैटर्न को पूरा करते हैं।

यह सब एक साथ रखना। अंतिम चरण

हमने पहेली पहेली कदम दर कदम हल करने के लिए सभी आवश्यक कार्य बनाए। अब समाधान पाने के लिए सब कुछ खूबसूरती से इकट्ठा करना महत्वपूर्ण है। एक उदाहरण के रूप में, मैं एक क्रॉसवर्ड पहेली का उपयोग करता हूं, जिसे जापानी वर्ग पहेली "आराम" की कीव पत्रिका से लिया गया है। इसके लेखक ए। लेउता हैं।

क्रॉसवर्ड पहेली को प्रोग्राम में पंक्तियों और स्तंभों की कुंजी की सूची के रूप में सेट किया गया है।

rows = {{1}, {2}, {4}, {3,1}, {4,1}, {12}, {9}, {4,1}, {1,1,1,1,1}, {1,1,1,1}, {1,3,1}, {2,1,1}, {9,1}, {4,5,1}, {3,4,1}, {3,5,3}, {3,1,5}, {5,1,2}, {7,3}, {4,10}, {4,3,3}, {4,2,3}, {5,2,2}, {5,3,2}, {4,1,1,2}, {3,2,2}, {2,2}, {7}, {10}, {2,6}};

cols = {{3}, {6}, {8}, {13}, {1,12,1}, {2,7,2,1}, {5,2,7,4}, {5,3,12}, {8,2,3,1,1,2}, {8,2,1,3}, {2,3,4,1,4}, {2,2,1,1,5,3,5}, {4,6,7,2}, {2,3,3,8,2}, {1,2,2,2}, {1,4,1}, {2}, {2}, {9}, {1}};


आपको ग्रिड आकारों में प्रवेश करने की आवश्यकता नहीं है, क्योंकि आप उन्हें वैसे भी परिभाषित कर सकते हैं:

rowlength = Length[cols]

collength = Length[rows]


कार्यक्रम में, ड्राइंग को सूचियों की सूची या एक साधारण मैट्रिक्स के रूप में संग्रहीत किया जाएगा। निर्णय से पहले, हमारे पास जानकारी नहीं है, इसलिए इसका प्रत्येक तत्व एक तारांकन होगा।

pic = ConstantArray["*", {collength, rowlength}];


अब क्रॉसवर्ड पहेली समाधान का सबसे बोझिल हिस्सा सभी प्रकार के स्थानों की सूची भर रहा है। यहां आपको थोड़ा इंतजार करने की जरूरत है।

rowpos = allPositions[rowlength, #]& /@ rows;

colpos = allPositions[collength, #]& /@ cols;


जब सभी स्थान भर जाएँ, तो आप निर्णय ले सकते हैं। विचार यह है: भरी हुई कोशिकाओं की सभी पंक्तियों पर एक खोज की जाती है और इन कोशिकाओं को मुख्य ग्रिड में दर्ज किया जाता है। फिर, जो सूचनाएं प्राप्त होती हैं, वे स्तंभ लेआउट से हटा दी जाती हैं और स्तंभ खोजे जाते हैं, और इसी तरह। खोज तब तक चलेगी जब तक कि ग्रिड में कम से कम एक तारांकन न हो; मुझे लगता है कि लूप के संचालन की व्याख्या करने की आवश्यकता नहीं है। उपरोक्त कोड में MemberQ True अगर ग्रिड में कोई तारांकन है और अन्यथा False है। Transpose भी उपयोग किया जाता है ताकि आप पंक्तियों और स्तंभों के साथ समान रूप से काम कर सकें। चित्र प्रदर्शित करने के लिए, एक अंतर्निहित ArrayPlot फ़ंक्शन है जो सेल ब्लैक को पेंट करता है यदि यह 1 और सफेद है यदि 0 (तारांकन डिफ़ॉल्ट रूप से ब्राउज़ किया गया है)। यह देखने के लिए कि समाधान प्रक्रिया के दौरान पैटर्न कैसे बदलता है, Dynamic उपयोग किया जाता है।

Dynamic[ArrayPlot[pic, Mesh->True]]

While[MemberQ[pic, "*", 2],

pic = findInformation /@ rowpos;

colpos = MapThread[deleteFromList, {colpos, Transpose[pic]}];

pic = Transpose[findInformation /@ colpos];

rowpos = MapThread[deleteFromList, {rowpos, pic}];]


परिणाम इस तस्वीर है:

शायद किसी ने गौर किया कि समाधान बहुत ही उप-योग है। हां, यह है, लेकिन इष्टतमता बिंदु नहीं है। लेख का उद्देश्य यह दिखाना है कि वुल्फराम मैथमेटिका इस तरह की समस्या को आसानी से हल कर सकती है। लेकिन अगर हम पहले से ही इष्टतमता के बारे में बात कर रहे हैं, तो इस कार्य के लिए एल्गोरिथ्म को अनुकूलित करने के कई तरीके हैं, उदाहरण के लिए, केवल उन स्तंभों और पंक्तियों में जानकारी की खोज करना, जिनकी सेल जानकारी पिछले चरण में जोड़ी गई थी, कार्यक्रम के इस संस्करण में, खोज सभी कॉलमों में की जाती है। लाइनों।