3
$\begingroup$

Could a "verbal reasoning" problem like the following be solved with Mathematica? What comes next in the series.

KD XP NG VN QJ TL TM

Correct answer is RJ but how can it be done using Mathematica?

$\endgroup$
4
  • 2
    $\begingroup$ I'd say this question is widely out of scope for this site. $\endgroup$ May 23 at 7:51
  • 2
    $\begingroup$ Welcome to the Mathematica Stack Exchange. You could try the Puzzling SE site for a better response, perhaps. $\endgroup$
    – Syed
    May 23 at 7:59
  • 2
    $\begingroup$ It's a good idea to stay vigilant for some time after asking a question, better approaches may come later improving over previous replies. Experienced users may point out alternatives, caveats or limitations. In the future, I would advise users should wait at least 24 hours after answers stop arriving, before accepting the best answer. Accepting the first answer may be very kind, but discourages further replies. $\endgroup$
    – rhermans
    May 23 at 14:25
  • 3
    $\begingroup$ "What comes next" problems are notoriously not well-defined. $\endgroup$
    – Somos
    May 24 at 0:50

2 Answers 2

11
$\begingroup$

To look for a pattern,we get the character codes:

cc= ToCharacterCode["KDXPNGVNQJTLTM"]
(* {75, 68, 88, 80, 78, 71, 86, 78, 81, 74, 84, 76, 84, 77} *)

Then make 2 sequences with the 1,3,5.. and 2,4,6.. numbers. and take the second differences:

d12 = cc[[1 ;; -1 ;; 2]] // Differences // Differences
(* {-23, 18, -13, 8, -3} *)
d22 = cc[[2 ;; -1 ;; 2]] // Differences // Differences
(* {-21, 16, -11, 6, -1} *)

Aha, a pattern is emerging. The absolute values decrease each time by 5 and the sign is alternating. Therefore the next element of the first sequence is: -2 and of the second sequence is: -4.

We now need to undo the differences. This is done using "Accumulate" and prepending the first element of the original sequence. Therefore to undo the second difference:

t11 = Accumulate[Join[{13}, d12, {-2}]]
(*{13, -10, 8, -5, 3, 0, -2} *)
t21 = Accumulate[Join[{12}, d22, {-4}]]
(* {12, -9, 7, -4, 2, 1, -3} *)

And to undo the first difference:

t1 = Accumulate[Join[{75}, t11]]
(* {75, 88, 78, 86, 81, 84, 84, 82} *)
t2 = Accumulate[Join[{68}, t21]]
(* {68, 80, 71, 78, 74, 76, 77, 74} *)

Therefore, the character code of the 2 next characters are: 82 and 74. And the belonging characters:

FromCharacterCode /@ {82, 74}
(* {"R", "J"} *)
$\endgroup$
3
  • $\begingroup$ Very nice. I think you can edit the question to include Mathematica usage and thus keep it open. Your answer explains well how to undo Differences using Accumulate. $\endgroup$
    – Syed
    May 23 at 9:46
  • 2
    $\begingroup$ But this doesn't really use Mathematica to solve the problem - it uses Mathematica as something like a calculator to execute the steps that the solver has figured out might be useful. It's @DanielHuber who went Aha, a pattern is emerging, not Mathematica. There's a lot more work to be done to define a general-purpose WordProblemSolve function. And no, I haven't a clue how I'd start writing that function. $\endgroup$ May 23 at 11:01
  • 2
    $\begingroup$ @HighPerformanceMark: If you want something more automatic, take a look at my answer. $\endgroup$ May 23 at 13:30
19
$\begingroup$

Riffing off of DanielHuber's answer, and with less user intervention:

cc = ToCharacterCode["KDXPNGVNQJTLTM"]
f = FindSequenceFunction[cc];
FromCharacterCode[f@{15, 16}]

(* RJ *)

Effectively, we are leveraging Mathematica's built-in algorithms for analyzing number sequences by converting the letter sequence into a number sequence, having Mathematica figure out a function for that sequence, and then converting the result back into letters.

$\endgroup$
1
  • 3
    $\begingroup$ Yes, indeed, this strikes me as very much closer to having Mathematica solve the problem. $\endgroup$ May 23 at 14:11

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.