Wolfram mathematica 用mathematica编程寻找特定的完美平方数集

我的一位同事向他的C编程课提出了以下问题，我觉得这很有趣。它可以很容易地用任何编程语言完成，我立刻想到wolfram。 问题是：

数字25是一个唯一的完美正方形，如果我们将每个数字增加一，它将变成36，这也是一个完美正方形！ 编写一个程序来查找另一组具有相同质量的数字

我相信这在mathematica中很容易做到。 有人能解释一下我是如何在mathematica中做到这一点的吗。请注意，这个问题的原因只是一个借口，让我进入一个我一无所知的数学编程

---

谢谢大家。

让我们先在游泳池的浅水区帮你划水，而不是把你扔进海里

n=1;
While[n<100,
  d=IntegerDigits[n];(*get the list of digits making up n*)
  newd=d+1;(*add one to every element of the list giving a new list*)
  newn=FromDigits[newd];(*turn that new list of digits back into a number*)
  If[IntegerQ[Sqrt[newn]],Print[{n,newn}]];
  n++
]

这不仅仅是看n的平方值，它可能会给你提示如何增加数字和测试平方结果

在Mathematica中，做任何事情都至少有十几种不同的方式，其中一些文化围绕着使程序尽可能简短，并且可能神秘。你可以稍后再开始。开始使用新语言时，简单性似乎更好

---

我希望你玩得开心。

与其把你扔进海里，不如让我们先帮你在游泳池的浅水区划水

n=1;
While[n<100,
  d=IntegerDigits[n];(*get the list of digits making up n*)
  newd=d+1;(*add one to every element of the list giving a new list*)
  newn=FromDigits[newd];(*turn that new list of digits back into a number*)
  If[IntegerQ[Sqrt[newn]],Print[{n,newn}]];
  n++
]

这不仅仅是看n的平方值，它可能会给你提示如何增加数字和测试平方结果

在Mathematica中，做任何事情都至少有十几种不同的方式，其中一些文化围绕着使程序尽可能简短，并且可能神秘。你可以稍后再开始。开始使用新语言时，简单性似乎更好

---

希望您玩得开心。

一个更实用的解决方案

Table[x^2, {x, 1, 100}] // Select[IntegerQ[Sqrt[FromDigits[IntegerDigits[#] + 1]]] &]

数字9应该如何处理

IntegerDigits[19]
(* {1, 9} *)

IntegerDigits[19] + 1
(* {2, 10} *)

FromDigits[IntegerDigits[19] + 1]
(* 30 *)

---

如果+1携带，那么结果是20而不是30？

一个更实用的解决方案

Table[x^2, {x, 1, 100}] // Select[IntegerQ[Sqrt[FromDigits[IntegerDigits[#] + 1]]] &]

find[from_, to_] := Module[{a, b, c, d, e},
  a = Range[from, to];
  b = a^2;
  c = IntegerDigits[b];
  (*Add 1's to the digits of the square,
  except where the square contains a 9*)
  d = MapThread[
    If[MemberQ[#2, 9], Null,
      #1 + FromDigits[ConstantArray[1, Length[#2]]]] &,
    {b, c}];
  (*Find the positions where the square roots are integers*)
  e = Position[Sqrt[d], _?IntegerQ, {1}];
  Extract[a, e]]

find[1, 1000000]

数字9应该如何处理

IntegerDigits[19]
(* {1, 9} *)

IntegerDigits[19] + 1
(* {2, 10} *)

FromDigits[IntegerDigits[19] + 1]
(* 30 *)

+1是否应该进位，使结果数字为20而不是30

find[from_, to_] := Module[{a, b, c, d, e},
  a = Range[from, to];
  b = a^2;
  c = IntegerDigits[b];
  (*Add 1's to the digits of the square,
  except where the square contains a 9*)
  d = MapThread[
    If[MemberQ[#2, 9], Null,
      #1 + FromDigits[ConstantArray[1, Length[#2]]]] &,
    {b, c}];
  (*Find the positions where the square roots are integers*)
  e = Position[Sqrt[d], _?IntegerQ, {1}];
  Extract[a, e]]

find[1, 1000000]

{5,45,115,2205,245795,455645}

比如说

Sqrt[45^2 + 1111]

56

及

564556

{5,45,115,2205,245795,455645}

比如说

Sqrt[45^2 + 1111]

56

及

564556

---

您可以轻松地将其扩展到任何基数，只需知道该数字在给定基数中的长度。我的意思如下。假设基数为10，数字为25。要检查前提，我们需要添加11。但11只不过是：

25 + 11
= 25 + 10^1 + 10^0
= 25 + (10^2-1)/(10-1)
= 36 = 6^2

现在想象一下数字72×72=5184，但以基数3 518410=210100003表示。现在在基数3中进行计算，得到

21010000 + 11111111
= 21010000 + 3^7 + 3^6 + 3^5 + 3^4 + 3^3 + 3^2 + 3^1 + 3^0
= 21010000 + (3^8-1)/(3-1)
= 102121111 = 10102^2

其中1021211113=846410=9210×9210

正如您所注意到的，您所需要做的就是将数字bn-1/b-1添加到数字中，并检查它是否为正方形。这里n表示基数b中数字x的总位数

使用简单的lookuptable，可以在Mathematica中执行以下操作：

b = 10 
x = Table[n^2, {n, 1, 1000}];
Select[x, MemberQ[x, # + (b^IntegerLength[#, b] - 1)/(b - 1)] &];
{25, 289, 2025, 13225, 100489, 198025, 319225, 466489}

从基2到基10的完整列表如下：

Table[Select[x, MemberQ[x, # + (b^IntegerLength[#, b] - 1)/(b - 1)] &], {b, 2, 10}]

---

您可以轻松地将其扩展到任何基数，只需知道该数字在给定基数中的长度。我的意思如下。假设基数为10，数字为25。要检查前提，我们需要添加11。但11只不过是：

25 + 11
= 25 + 10^1 + 10^0
= 25 + (10^2-1)/(10-1)
= 36 = 6^2

现在想象一下数字72×72=5184，但以基数3 518410=210100003表示。现在在基数3中进行计算，得到

21010000 + 11111111
= 21010000 + 3^7 + 3^6 + 3^5 + 3^4 + 3^3 + 3^2 + 3^1 + 3^0
= 21010000 + (3^8-1)/(3-1)
= 102121111 = 10102^2

其中1021211113=846410=9210×9210

正如您所注意到的，您所需要做的就是将数字bn-1/b-1添加到数字中，并检查它是否为正方形。这里n表示基数b中数字x的总位数

使用简单的lookuptable，可以在Mathematica中执行以下操作：

b = 10 
x = Table[n^2, {n, 1, 1000}];
Select[x, MemberQ[x, # + (b^IntegerLength[#, b] - 1)/(b - 1)] &];
{25, 289, 2025, 13225, 100489, 198025, 319225, 466489}

从基2到基10的完整列表如下：

Table[Select[x, MemberQ[x, # + (b^IntegerLength[#, b] - 1)/(b - 1)] &], {b, 2, 10}]

---

Mathematica是一个交互式系统，有大量的文档记录，尤其是基本功能。打开笔记本，开始玩。了解如何在两位数的每一位数字上加1，了解如何求整数的平方根。停下来，想一想，继续三位数。停下来，再想一想，阅读有关简单函数定义的文档。现在你已经把你的脚趾伸进了数学的海洋。谢谢马克。我想我要淹死在那片海洋里了！哈哈：这个问题在另一个基础上得到了很好的扩展。Mathematica是一个交互式系统，有大量的文档记录，尤其是基本功能。打开笔记本，开始玩。了解如何在两位数的每一位数字上加1，了解如何求整数的平方根。停下来，想一想，继续三位数。停下来，再想一想，阅读有关简单函数定义的文档。现在你已经把你的脚趾伸进了数学的海洋。谢谢马克。我想我会被淹死的

---

海洋！哈哈：这个问题在另一个基础上得到了很好的扩展。我已经和一些鲨鱼在一起游泳了。我用了一个for循环，并在result=N[Sqrt[I]]之间的某个地方堆积起来。即使平方是Int也给我假：我甚至修正了你的if语句：它需要检查n是否也是完美平方！第一次游泳还不错！谢谢大家……我已经和一些鲨鱼在一起游泳了……我用了一个for循环，然后在result=N[Sqrt[I]]之间的某个地方堆积起来。即使平方是Int也给我假：我甚至修正了你的if语句：它需要检查n是否也是完美平方！第一次游泳还不错！谢谢大家……投了赞成票。很好的洞察力。有一个小错误。基本形式[5184,3]=21010000，而不是210011200。很好的洞察力。有一个小错误。基型[5184,3]=21010000，而不是21001200。