16
$\begingroup$

Inspired by Interesting ways to write 2023, I was wondering if there are ways to automate the search for results using MMA.

I tried

  PowersRepresentations[2023, 3, 2]

However, it did not provide output ($2023$ is not a number that can written as the sum of three squares).

However,

  PowersRepresentations[2023, 4, 2]

Provides many examples of the sum of four squares.

Are there any other commands in Mathematica to provide solutions or a way to automate searching some out that are not the plethora of the above?

Happy New Year to all!

Update

I found this interesting code (I cannot decode it) at Write a Number as a Fibonacci Sum, just enter $2023$ at the prompt.

  i=Input[];#~Row~"+"&/@Select[If[#>i,Subsets@{##},#0[#+#2,##]]&[2,1],Tr@#==i&]//Column
Improve this question
$\endgroup$
6
  • 2
    $\begingroup$ Best wishes for a happy new year! I guess we are looking for generic ways to represent 2023 and so does IntegerPartitions[2023] count? $\endgroup$
    – bmf
    Commented Jan 1, 2023 at 3:17
  • 3
    $\begingroup$ There was also some intense integration formulas for 2019 that one might adapt to 2023 : math.stackexchange.com/q/3058069/1049002 $\endgroup$
    – userrandrand
    Commented Jan 1, 2023 at 5:28
  • 2
    $\begingroup$ Insert +, −, ×, /, (, ) into 123456789 to make it equal to 100 $\endgroup$
    – chyanog
    Commented Jan 1, 2023 at 10:17
  • 2
    $\begingroup$ For a random partition: ResourceFunction["RandomIntegerPartition"][2023] $\endgroup$
    – userrandrand
    Commented Jan 1, 2023 at 14:01
  • 1
    $\begingroup$ @userrandrand: Excellent - I am always amazed at the number of interesting functions built into MMA. I wish I could spend lots of time just studying them! Happy new year! $\endgroup$
    – Moo
    Commented Jan 1, 2023 at 15:20

5 Answers 5

Reset to default
14
$\begingroup$

I would like to point out FrobeniusSolve, e.g. this yields nonnegative solutions $(x_1,x_2)$ of this equation $20 x_1 +23 x_2 =2023$

FrobeniusSolve[{20, 23}, 2023]

{{8, 81}, {31, 61}, {54, 41}, {77, 21}, {100, 1}}

FrobeniusSolve yields an unbounded set (it is finite but sometimes enormous) of possibilites of representing a given number, e.g.

FrobeniusSolve[{2, 3, 5, 7}, 2023] // Length

6653921

Edit

FrobeniusSolve as well as Reduce, Solve and FindInstance provide huge set of variations of the method mentioned above. However we can exploit quite a different approach.

FactorInteger[2023, GaussianIntegers -> True]

{{-1, 1}, {1 + 4 I, 2}, {4 + I, 2}, {7, 1}}

and so with GaussianIntegers we can write:

-1 (1 + 4 I)^2 (4 + I)^2 7

2023

Similarily with integer factorization ($2023=7\cdot 17^2$) we can find examples of integers for which the geometric mean provides $2023$

GeometricMean /@ {{833, 4913}, {49, 83521}, {119, 34391}}

 {2023, 2023, 2023}

There are plenty of analytic methods, e.g.

summation of the harmonic series:

N[ HarmonicNumber[21235148975836561123684489978 10^850], 32]

2023.0000000000000000000000000000

Imaginary part of the argument of the Riemann Zeta function on the critical line between $1538$-th and $1539$-th zero is $2023$:

{Ceiling @ Im @ ZetaZero @ 1538,  Floor @ Im @ ZetaZero @ 1539}

 { 2023, 2023}

Curiously we can also express the number symetrically with three sevens

HoldForm[Prime[7] 7 Prime[7]] // TraditionalForm
ReleaseHold @ %

$$p_7\; 7\; p_7$$

 2023
Improve this answer
$\endgroup$
2
  • 4
    $\begingroup$ (+1) and I am very impressed that FrobeniusSolve[{2, 3, 5, 7}, 2023] gives a result and does not crash the kernel! $\endgroup$
    – bmf
    Commented Jan 1, 2023 at 3:55
  • 1
    $\begingroup$ @Artes: Very creative updates! $\endgroup$
    – Moo
    Commented Jan 1, 2023 at 18:52
12
$\begingroup$

Happy new year!

IntegerDigits[2023, 2]

{1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1}

Edit: another interesting way

NumberExpand[2023, base]

and then we can specify the base. An example is to consider the base of 5

NumberExpand[2023, 5]

{1875, 125, 0, 20, 3}

Edit 2:

FactorInteger[2023]

{{7, 1}, {17, 2}}

Improve this answer
$\endgroup$
4
  • 2
    $\begingroup$ Happy new year, mate! 1012^2 - 1011^2 :-) $\endgroup$
    – E. Chan-López
    Commented Jan 1, 2023 at 3:27
  • 1
    $\begingroup$ Happy new year! Best wishes :-) That's a nice one btw $\endgroup$
    – bmf
    Commented Jan 1, 2023 at 3:27
  • 1
    $\begingroup$ For fun and curiosity here is an image of the output of a cellular automaton with rule 110 where the initial condition is the binary representation of 2023 : i.sstatic.net/RviWE.png $\endgroup$
    – userrandrand
    Commented Jan 1, 2023 at 13:42
  • 1
    $\begingroup$ @userrandrand Seems like a complicated tetris structure :) $\endgroup$
    – bmf
    Commented Jan 1, 2023 at 13:46
11
$\begingroup$

I thought it could be nice to use different domains of Mathematica to represent 2023 in different ways.

Outline:

  • Entities
  • Polynomial algebra
  • Linguistic Data
  • Number theory
  • Text analysis
  • Special functions
  • Plotting

For the fun of it, here is the outline as an unordered wordcloud with DropShadowing (version 13.1) :

Note : Text placement might differ each time as it is random.

WordCloud[{"Entities", "Polynomial algebra", "Linguistic data", 
   "Number theory", "Text analysis", "Special functions", "Plotting", 
   Rotate["2023", Pi/3]}] /. 
 Graphics[{a_, b___}, c___] :> Graphics[{DropShadowing[], a, b}, c]

enter image description here

Entities

Write 2023 as the approximate ratio between the mass of an exoplanet and that of earth.

Mass of the earth:

earthMass = 
  Entity["Planet", "Earth"][EntityProperty["Planet", "Mass"]];

The exoplanets that have a mass that is roughly 2023 times that of the earth :

FilteredEntityClass["Exoplanet", 
  EntityFunction[e, 
   Abs[e["Mass"]/(2023*earthMass) - 1] < 0.1]] // EntityList

enter image description here

Polynomial algebra

Find an expression for 2023 in terms of radicals.

Using the general formula for a quartic:

sol = Solve[x^4 + a*x^3 + b*x^2 + c*x + d == 0, x];

Considering a random monic polynomial that has root 2023:

coefrule = {d, c, b, a} -> (Drop[#, -1] &)@
    CoefficientList[(RandomInteger[{1, 5}, 3] . x^Range[0, 2] + 
        x^3)*(x - 2023), x] // Thread

Thus another representation of 2023 that most people might be less familar with is :

$$2023=\frac{1}{2} \sqrt{\frac{1}{3} \sqrt[3]{\frac{1}{2} \left(49748794692 \sqrt{705}-1342923812836\right)}-\frac{24470164}{3} (-1)^{2/3} \sqrt[3]{\frac{2}{1342923812836-49748794692 \sqrt{705}}}+\frac{3072436}{3}}+\frac{1}{2} \sqrt{-\frac{1}{3} \sqrt[3]{\frac{1}{2} \left(49748794692 \sqrt{705}-1342923812836\right)}+\frac{1}{3} (-1)^{2/3} 24470164 \sqrt[3]{\frac{2}{1342923812836-49748794692 \sqrt{705}}}+\frac{6144872}{3}+\frac{2072863396}{\sqrt{\frac{1}{3} \sqrt[3]{\frac{1}{2} \left(49748794692 \sqrt{705}-1342923812836\right)}-\frac{24470164}{3} (-1)^{2/3} \sqrt[3]{\frac{2}{1342923812836-49748794692 \sqrt{705}}}+\frac{3072436}{3}}}}+505$$

Linguistic data

Write the year 2023 in some of the most spoken languages.

First find the the top 10 most spoken languages. I used free form with ctrl+= followed by top 10 most spoken languages. After applying EntityList we have:

enter image description here

Unfortunately the code below does not work with a lot of languages so I took the top 20 most spoken an extracted the cases that worked.

languages = 
 EntityClass[
   "Language", {EntityProperty["Language", "TotalSpeakers"] -> 
     TakeLargest[20]}] // EntityList

Then we use IntegerName to write the year 2023 and we also use Transliterate to write the word in ASCII format:

(
languages
//Map[{CommonName@#,
        IntegerName[2023,
                    "Year",
                    Language->#]
        //{Identity,Transliterate}//Through
        //Splice
    }&]
//Quiet
//DeleteCases[_?(Not@*FreeQ[_IntegerName])]
)

Unfortunately the output seemed to have errors with east asian languages so I removed those manually. I also used TraditionalForm as it looked nicer.

enter image description here

Curated version

There seems to be an error for the name for 2023 in french (but maybe that is how it is pronounced in Canada not sure). Hence, I changed it in the table below. Upon request I also added Greek. Greek is not given in the dropdown menu when typing a language with IntegerName but it still works with IntegerName[2023, "Year", Language -> "Greek"]. Feel free to leave a comment with the translation in your language.

enter image description here

Number theory

Characterize 2023 as the unique number specifying a number theory related property

2023 is the only lucky number of this decade.

The list of lucky numbers lower than a certain integer can be found using the resource function LuckyNumbers. The list below shows the last 2 before 2030.

ResourceFunction["LuckyNumbers"][2030][[-2 ;; -1]]
(* {2019, 2023} *)

Text analysis

Characterize 2023 as the year where certain events are planned to occur.

One can use the wikipedia page on 2023 :

data = WikipediaData["2023"];

Then we can extract the list of events using:

TextSentences[StringExtract[data, "==" -> 5]]

Bonus: For a given event in that list we can get a data set of text contents using TextContents and we can ask questions about the event from the text content using FindTextualAnswer.

Special functions

Write 2023 as a MeijerG function evaluated on an explicit argument.

Consider a simple function and find the MeijerG representation:

expression=1/(1 + x^2) // MeijerGReduce[#, x] &

Find a value for x where the function is equal to 2023 :

sol = Solve[1/(1 + x^2) == 2023][[1]]

The result :

expression /. sol

$$\text{MeijerG}\left[\{\{0\},\{\}\},\{\{0\},\{\}\},-\frac{2022}{2023}\right]$$

Plotting

Write 2023 as the limit of a sequence and plot that sequence to visualize the limit and accuracy

Consider a continued fraction representation of 2023 as Exp[ContinuedFraction[Log[2023]]]. In the following we will plot the convergence of the sequence u[n]=Exp[ContinuedFraction[Log[2023]],n] using the resource function MultipleAxesPlot.

Visualizing the sequence :

digits = ContinuedFraction[Log[2023], 20];

Table[digits[[1]] + 
     ContinuedFractionK[(HoldForm /@ digits)[[k]], {k, 2, l}], {l, 1, 
     7}] // Map[Exp] // Quiet // TraditionalForm

$$\left\{e^7,e^{7+\frac{1}{1}},e^{7+\frac{1}{1+\frac{1}{1}}},e^{7+\frac{1}{1+\frac{1}{1+\frac{1}{1}}}},e^{7+\frac{1}{1+\frac{1}{1+\frac{1}{1+\frac{1}{1}}}}},e^{7+\frac{1}{1+\frac{1}{1+\frac{1}{1+\frac{1}{1+\frac{1}{2}}}}}},e^{7+\frac{1}{1+\frac{1}{1+\frac{1}{1+\frac{1}{1+\frac{1}{2+\frac{1}{1}}}}}}}\right\}$$

Interpolate the sequence and Log10 of the relative error with respect to the limit:

curves = 
  Exp@Convergents[Log[2023], 20] // {Interpolation, 
     Interpolation[Log10[Abs[#/2023 - 1]] ] &} // Through;

Plot the sequence using the resource function MultipleAxesPlot:

options = {PlotStyle -> {RGBColor[0.0737601, 0.865914, 0.132145], 
     RGBColor[0.874018, 0.204385, 0.872946]}, 
   "SecondaryAxesColor" -> RGBColor[0.874018, 0.204385, 0.872946]};

ResourceFunction["MultipleAxesPlot"][Through[curves[x]], {x, 1, 20}, 
 Sequence @@ options]

enter image description here

Improve this answer
$\endgroup$
16
  • 2
    $\begingroup$ Very nice and creative (+1)! Happy New Year! $\endgroup$
    – Moo
    Commented Jan 1, 2023 at 12:26
  • 1
    $\begingroup$ Thank you happy @Moo year (; $\endgroup$
    – userrandrand
    Commented Jan 1, 2023 at 12:29
  • 3
    $\begingroup$ (+1) all suggestions were great, but the first one in particular was spectacular. happy new year! $\endgroup$
    – bmf
    Commented Jan 1, 2023 at 12:35
  • 2
    $\begingroup$ Thank you @bmf (:. I thought the first might be liked more so I placed it first as an attention grabber (:. Happy new year ! $\endgroup$
    – userrandrand
    Commented Jan 1, 2023 at 13:09
  • 3
    $\begingroup$ @userrandrand I am very impressed by the amount of work you did on your answer!!! A very small contribution, as a token of appreciation, if you wish to include it is the following: in Greek 2023 is δύο χιλιάδες είκοσι τρία. $\endgroup$
    – bmf
    Commented Jan 2, 2023 at 14:55
6
$\begingroup$

According to the Goldbach conjecture, 2023 can be written as a sum of 3 primes... we can find these using:

FindInstance[2023 == a + b + c, {a, b, c} \[Element] Primes]

In fact, you can find lots of such 3-prime sums:

FindInstance[2023 == a + b + c, {a, b, c} \[Element] Primes, 10]

Can we find a so that $\lfloor (a-1/a)^2 \rfloor$ is equal to 2023? Sure thing:

$MaxPiecewiseCases = 3000; 
FindInstance[2023 == Floor[(a - 1/a)^2], a \[Element] Integers, 2]

And, inspired by the comment of E. Chan-López

FindInstance[2023 == (a + 1)^2 - a^2, a \[Element] Integers]
Improve this answer
$\endgroup$
2
$\begingroup$ 
SequenceCases[RealDigits[Glaisher, 10, 111][[1]], {2, 0, 2, 3}]

{{2, 0, 2, 3}}

list = RealDigits[Glaisher, 10, 111][[1]];

p = List /@ Range @@ First @ SequencePosition[list, {2, 0, 2, 3}]

{{95}, {96}, {97}, {98}}

ReplaceAt[x_ :> Style[x, Bold], p] @ list

enter image description here

The Glaisher - sequence was found at oeis.org

Improve this answer
$\endgroup$
1
  • $\begingroup$ Interesting. ${}{}$ + 1 $\endgroup$
    – Moo
    Commented May 27 at 23:09

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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