Transform recursion into tail recursion

Posted on November 6, 2024 by rpflee

Remove a white dot from the photo | Euler problem 24.1.2

(defmacro detailn (fn (n)
                   (if endc
                       b-val
                       (op n (fn (ch n)))))
  (let ((acc (gensym)))
    `(defun ,fn (,n)
       (labels ((fn-iter (,n ,acc)
                  (if ,endc
                      ,acc
                      (fn-iter (,ch ,n)
                               (,op ,n ,acc)))))
         (fn-iter ,n ,b-val)))))

(detailn facn (m)
         (if (<= m 1)
             1
             (* m (facn (1- m)))))

(macroexpand '(detailn fac (m)
               (if (<= m 1)
                   1
                   (* m (fac (1- m))))))

— Fixed by GIMP’s Clone Tool

— Me@2024-10-30 12:42:22 PM

Euler problem 24.1.1

Posted on October 30, 2024 by rpflee

To formalize, if $a_0 < \ldots < a_n$ , then in the k-th permutation of $\{a_0, \ldots, a_n\}$ in lexicographic order, the leading entry is $a_q$ if $k = q(n!) + r$ for some $q \geq 0$ and $0 < r \leq n!$ . (Note that the definition of $r$ here is a bit different from the usual remainder, for which $0 \leq r < n!$ . Also, $a_q$ is the $(q+1)$ -th entry but not the $q$ -th entry in the sequence, because the index starts from 0.)

— edited Aug 30, 2011 at 18:23
— answered Aug 30, 2011 at 17:59
— user1551
— math stackexchange

Why $r$ Cannot Be Zero: If $r$ were allowed to be zero, it would imply that the leading entry of the permutation could be determined without any remaining elements to choose from, which contradicts the requirement of having a valid permutation. In other words, a remainder of zero would mean that we have perfectly divided $k$ by $n!$ , leading us to a situation where we would not be able to select the next element in the permutation sequence.

— AI Assistant

Euler problem 23.3

Posted on October 25, 2024 by rpflee

Watermelon 3

isAbundant[n_] :=
    Module[{sumDivisors},
        sumDivisors = Total[Divisors[n]] - n;
        sumDivisors > n]

abundantNumbers[a_, b_] :=
    Select[
        Range[a, b],
        isAbundant]

L := 28123

abundantList := abundantNumbers[1, L]

firstHalfAbundantList :=
    abundantNumbers[1, Quotient[L,2]]

abundantSums[aList_, bList_] :=
    DeleteDuplicates[
        Flatten[
            Table[
                aList[[i]] + bList[[j]],
                {i, Length[aList]},
                {j, Length[bList]}]]]

nonAbundantSums[limit_] :=
    Total[
        Complement[
            Range[1, limit],
            abundantSums[
                firstHalfAbundantList,
                abundantList]]]

result = Timing[nonAbundantSums[L]]

{1.73236, 4179871}

— Me@2024-10-20 01:49:38 PM

Euler problem 23.2

Posted on October 21, 2024 by rpflee

import Data.Array as Array ( Array )
import Data.Array.Base ( (!), listArray )
import Data.List (group)

primes :: [Int]
primes = 2 : filter (null . tail . (pfa !)) [3, 5 ..]

ub :: Int
ub = 28123

pfa :: Array Int [Int]
pfa = listArray (2, ub) $ map pf [2..ub]

pf :: Int -> [Int]
pf n = factor n primes
  where
    factor n (p : ps)
      | p * p > n = [n]
      | n `mod` p == 0 = p : pfa ! (n `div` p)
      | otherwise = factor n ps

groupFactors :: [Int] -> [[Int]]
groupFactors xs = [[head x, length x] | x <- group xs]

genDiv :: [[Int]] -> [Int]
genDiv = foldr combine [1]
  where
    combine [p, n] acc
      = [x * p^e | x <- acc, e <- [0..n]]

sumProperDivisors :: Int -> Int
sumProperDivisors n
  = -n + sum (genDiv $ groupFactors $ pfa ! n)

isAbundant :: Int -> Bool
isAbundant n = sumProperDivisors n > n

abdSieve :: Array Int Bool
abdSieve = listArray (2, ub) $ map isAbundant [2..ub]

abundantNumbers :: Int -> [Int]
abundantNumbers m
  | m > ub = filter isAbundant [2..m]
  | otherwise = filter (abdSieve !) [2..m]

abundantList :: [Int]
abundantList = abundantNumbers ub

isAbundantSum :: Int -> Bool
isAbundantSum n 
  = any (\a -> abdSieve ! (n-a))
    $ takeWhile (<= n `div` 2) abundantList

notAbundantSumsList :: Int -> [Int]
notAbundantSumsList m
  = filter (not . isAbundantSum) [1..m]

λ> :set +s
λ> sum (notAbundantSumsList ub)
4179871
(1.14 secs, 1,772,425,584 bytes)
λ>

— Me@2024-10-19 09:53:30 PM

Euler problem 23.1.2

Posted on October 5, 2024 by rpflee

(defmacro abundant-numbers (limit)
  `(filter (macro-to-function is-abundant)
           (gen-list 1 ,limit)))

(defmacro none (predicate lst)
  `(not (some ,predicate ,lst)))

(defmacro take-while (predicate lst)
  `(labels ((take-while-iter (a-lst acc)
              (if (null a-lst)
                  (nreverse acc)
                  (let ((head (car a-lst))
                        (tail (cdr a-lst)))
                    (if (funcall ,predicate head)
                        (take-while-iter tail (cons head acc))
                        (nreverse acc))))))
     (take-while-iter ,lst '())))

(defmacro drop-while (predicate lst)
  `(labels ((drop-while-iter (a-lst)
              (if (null a-lst)
                  a-lst
                  (let ((head (car a-lst))
                        (tail (cdr a-lst)))
                    (if (funcall ,predicate head)
                        (drop-while-iter tail)
                        a-lst)))))
     (drop-while-iter ,lst)))

(defun create-hash-from-list (lst)
  (let ((hash (make-hash-table :test 'equal)))
    (dolist (item lst)
      (setf (gethash item hash) t))
    hash))

(defun is-not-abundant-sum (n abundant-list)
  (let* ((half-n-floor (floor (/ n 2)))
         (first-half (take-while #'(lambda (x) (<= x half-n-floor)) abundant-list))
         (second-half (drop-while #'(lambda (x) (< x half-n-floor)) abundant-list))
         (second-half-to-n (take-while #'(lambda (x) (< x n)) second-half))
         (second-half-hash (create-hash-from-list second-half-to-n)))
    (none (lambda (a)
            (let ((b (- n a)))
              (gethash b second-half-hash)))
          first-half)))

(defun not-abundant-sums-list (limit)
  (let ((abundant-list (abundant-numbers limit)))
    (filter #'(lambda (n)
                (is-not-abundant-sum n abundant-list))
            (gen-list 1 limit))))

CL-USER> (time (sum (not-abundant-sums-list 28123)))
 Evaluation took:
  2.481 seconds of real time
  2.477531 seconds of total run time (2.389778 user, 0.087753 system)
  [ Run times consist of 0.152 seconds GC time, and 2.326 seconds non-GC time. ]
  99.88% CPU
  6,194,100,940 processor cycles
  7,411,226,352 bytes consed
  
4179871

— Me@2024-10-04 03:38:12 PM

Euler problem 23.1.1

Posted on September 21, 2024 by rpflee

(defmacro sum (lst)
  `(reduce #'+ ,lst))

(defun proper-divisors (n)
  (when (> n 1)  
    (let ((divisors '())
          (limit (floor (sqrt n))))  
      (loop :for i :from 1 :to limit
            :when (zerop (mod n i))  
              :do (progn
                    (push i divisors)  
                    (when (/= n (floor n i))  
                      (push (floor n i)
                            divisors))))  
      (remove-duplicates (sort divisors #'<)
                         :test
                         #'equal))))

(defmacro sum-proper-divisors (n)
  `(sum (proper-divisors ,n)))

(defmacro is-abundant (n)  
  `(> (sum-proper-divisors ,n) ,n))

(defmacro gen-list (min max)
  `(loop :for n :from ,min :to ,max
         :collect n))

(defmacro filter (predicate list)
  `(remove-if-not ,predicate ,list))

(defmacro macro-to-function (macro-name)
  `(lambda (xs) (,macro-name xs)))

(defmacro db (x)
  `(* 2 ,x))

((lambda (xs) (db xs)) 2.1)

(funcall (macro-to-function db) 2.1)

;; Evaluation Context:

;; ((macro-to-function db) 2.1): This line attempts to call the result of the macro macro-to-function directly as if it were a function. However, since macro-to-function returns a lambda expression, this results in an "illegal function call" error because the macro is not expanded in the context of a function call.

;; (funcall (macro-to-function db) 2.1): In this line, funcall is used to invoke the lambda function returned by macro-to-function. This correctly evaluates the lambda and applies it to 2.1, allowing the macro to be expanded properly.

(defmacro abundant-numbers (limit)
  `(filter (macro-to-function is-abundant) (gen-list 1 ,limit)))

— Me@2024-09-20 11:53:30 PM

Sub ExportCalendarToOrgMode()

Posted on September 15, 2024 by rpflee

Sub ExportCalendarToOrgMode()
    Dim objFolder As Outlook.Folder
    Dim objAppointment As Outlook.AppointmentItem
    Dim strOutput As String
    Dim objFile As Object
    Dim strFilePath As String
    Dim totalAppointments As Integer

    strFilePath = "Z:\media\d\Outl.org"

    Set objFolder = Application.Session.GetDefaultFolder(olFolderCalendar)

    For Each objAppointment In objFolder.Items
        strOutput = strOutput & "* " & objAppointment.Subject & vbCrLf
        strOutput = strOutput & "SCHEDULED: <" & Format(objAppointment.Start, "yyyy-MM-dd>") & vbCrLf
        strOutput = strOutput & "DESCRIPTION: " & objAppointment.Body & vbCrLf
        strOutput = strOutput & vbCrLf

        totalAppointments = totalAppointments + 1
    Next objAppointment

    Set objFile = CreateObject( "Scripting.FileSystemObject" ).CreateTextFile(strFilePath, True)
    objFile.Write strOutput
    objFile.Close

    MsgBox "Calendar exported to: " & strFilePath & vbCrLf & "Total appointments exported: " & totalAppointments, vbInformation
End Sub

Sub ShiftCalendarEvents()
    Dim calFolder As Object
    Dim calItems As Object
    Dim calItem As Object
    Dim startDate As Date
    Dim endDate As Date
    Dim shiftDays As Integer

    shiftDays = 7

    ' 9 represents olFolderCalendar in Outlook 2010
    Set calFolder = Application.Session.GetDefaultFolder(9)

    Set calItems = calFolder.Items

    For Each calItem In calItems
        If calItem.Class = 26 Then ' 26 represents olAppointment in Outlook 2010
            calItem.Start = DateAdd("d", shiftDays, calItem.Start)
            calItem.Duration = 60
            calItem.Save
        End If
    Next calItem

    MsgBox "Calendar events have been shifted by " & shiftDays & " days."
End Sub

— Me@2024-09-14 12:47:16 PM

Euler problem 22.2

Posted on September 10, 2024 by rpflee

import Data.Char (ord)
import Data.List (sort)

score word
  = sum $ map (\char -> ord char - ord 'A' + 1) word

nameScore filename = do
  content <- readFile filename
  let    
    names = read $ "[" ++ content ++ "]"       
  return $
    sum $ zipWith (*) [1..] $ map score $ sort names

λ> nameScore "names.txt"
871198282
λ>

— Me@2024-09-09 03:40:11 PM

Chrono Cross 3

Posted on September 7, 2024 by rpflee

Chrono Trigger 5

Master Gogh is an unfortunate man.

In his youth, the master was a promising artist, but since her ladyship had a frail constitution, she fell ill after the birth of the young master.

Back then, the master was very poor… Without money to buy medicine, he could only watch her ladyship pass away. He changed that day.

He started working constantly, without a moment’s rest.

My master’s devotion to collecting all those works of art must be due to dreams he couldn’t fulfill when he was younger.

— Chrono Cross

2024.09.07 Saturday ACHK

Euler problem 22.1

Posted on September 4, 2024 by rpflee

(ql:quickload "str")

(defun score (word)
  (loop :for char :across word
        sum (+ (- (char-code (char-upcase char))
                  (char-code #\A))
               1)))

(defun remove-quote (name)
  (remove #\" name))

(defmacro zipWith (f xs ys)
  `(mapcar ,f ,xs ,ys))

(defmacro range (max &key (min 0) (step 1))
  `(loop :for n :from ,min :below ,max :by ,step
        collect n))

(defun name-scores (filename)
  (with-open-file (stream filename)
    (let* ((names (read-line stream))
           (name-list-q (str:split #\, names))
           (name-list (mapcar #'remove-quote name-list-q))
           (sorted-name-list (sort name-list #'string<))
           (score-list (mapcar #'score sorted-name-list))
           (n-list (range (1+ (length score-list)) :min 1))
           (i-score-list (zipWith #'* n-list score-list)))
      (reduce #'+ i-score-list))))

(name-scores "names.txt")

; SLIME 2.28To load "str":
  Load 1 ASDF system:
    str
; Loading "str"
...

CL-USER> (name-scores "names.txt")
871198282
CL-USER>

— Me@2024-09-04 10:43:19 AM

KDE Chinese, 2.2

Posted on August 30, 2024 by rpflee

<div style="color: #333333; font-size: 20px; font-family: AR PL UKai TW">
楷書測試
</div>

楷書測試

The above Chinese characters should be displayed in the regular script font (楷書). Otherwise, you need to install this package on your Linux distribution:

fonts-arphic-ukai

— Me@2024-08-13 01:41:14 PM

texrendr

Posted on August 23, 2024 by rpflee

— Me@2024-08-23 12:53:08 PM

Where are you?

Posted on August 19, 2024 by rpflee

Utopia | 何有之鄉, 2

有些人比天使更加美麗.

有些人比魔鬼更加醜惡.

在哪裡,

可以找到比天使更美的人?

— Me

這個想法是錯誤的。記住：

天使即魔鬼

原因是，任何兩個人，都起碼會因為喜好的不同，而相處不舒服。如果有一個對象，相處時十分理想，竟然沒有任何形式的不舒服，那是因為那個對象，是騙子創造出來的角色。

那個騙子飽讀詩書，有能力亦有意圖，根據和你基本的對話，了解你想要的理想對象，有什麼條件。然後投其所好（投你所好），創造那個虛擬人物出來，和你相處，從而騙取你的金錢或更多。（網上的那個她，往往是一個他，反之亦然。）你說你對物理有興趣，他會立刻長篇大論，相對論加量子力學。你話你對歷史有研究，他就馬上高談闊論，羅馬帝國衰亡史。

謊言是美好，現實是殘酷。

大部人的錯誤概念是，愛情主要帶來快樂。實情是：

愛情是吃苦，婚姻是受罪。

正如，上班是吃苦的過程，為的是換取金錢。「理想工作」這概念教壞人。企圖找到「理想工作」，很容易導致，永久不工作。

如果某項工作是快樂的，其他人，主要是僱主本身，一早就自己做了。正正是工作厭惡，僱主不想自己做，他才把其推給你做。而薪金就是補償。

同理，婚姻是受罪的經歷，為的是換取子女。「理想對象」這概念教壞人。企圖找到「理想對象」，很容易導致，永久無對象。（如果是主動選擇單身，則不是問題。但是，幻想有理想對象的人，必然不想單身。）

如果某個對象那麼理想，她就要麼早已名花有主，要麼不需要婚姻；兩種情況，由始至終，根本不需要你。

所以，選擇工作職位的原則，並不是找「理想工作」，而是找厭惡得來，仍然可以遷就到的工作。換句話說，排除那些「不可能遷就到」的工作便行。

沒有無刺的玫瑰
但有很多沒有玟瑰的刺

— 叔本華

不可能遷就到，而必須辭職的例子有：

一、薪金低到連正常的，衣食往行也不夠。

…

— Me@2024-08-19 03:25:32 PM

2009.08.14 Friday $\copyright ACHK$

Euler problem 21.2.2

Posted on August 18, 2024 by rpflee

import Data.Array ( (!), accumArray )

-- ...
    
p21 :: Integer -> Integer
p21 max_ = sum $ filter isAmicable [1 .. max_ - 1]
  where     
    gen n | n > max_ = []
          | otherwise = [(i*n, n) | i <- [2 .. max_ `div` n]] ++ gen (n+1)
    arr = accumArray (+) 0 (0, max_) (gen 1)
    arrb b | b < max_ = arr!b
           | otherwise = sumProperDivisors b
    isAmicable a = let b = (arr!a)
                     in b /= a && arrb b == a

λ> :set +s
λ> p21 10000
31626
(0.06 secs, 71,654,248 bytes)
λ> p21 100000
852810
(0.69 secs, 911,377,712 bytes)
λ> p21 1000000
27220963
(9.84 secs, 11,333,936,728 bytes)
λ> p21 10000000
649734295
(134.77 secs, 139,491,977,584 bytes)
λ>

— Me@2024-08-18 07:32:17 AM

Perpendicular universes

Posted on August 15, 2024 by rpflee

Parallel universes refer to alternate realities that exist alongside our own universe. They are often depicted as having similar physical laws and structures but differing in specific details, such as historical events or individual choices. The idea is that these universes run parallel to each other, much like parallel lines in geometry that never intersect.

Perpendicular universes, on the other hand, are a less commonly discussed concept and are often more speculative or fictional. The term suggests a different dimensional relationship, where these universes might intersect or interact at certain points, akin to how two lines can meet at a right angle.

In some interpretations, perpendicular universes could imply that they have fundamentally different physical laws or constants, leading to vastly different realities. This could allow for interactions or overlaps between the universes, unlike parallel universes, which remain distinct and separate.

45-degree universes are an even more abstract concept, often described as hybrid universes that share properties of both parallel and perpendicular universes.

Summary of Differences

Interaction: Parallel universes do not interact with each other, while perpendicular universes may have points of intersection or interaction.
Dimensionality: Parallel universes are often thought of as existing in the same dimensional space, whereas perpendicular universes suggest a different dimensional relationship.
Physical Laws: Parallel universes typically share similar physical laws, while perpendicular universes might operate under entirely different rules.

— AI

2024.08.15 Thursday ACHK

Watermelon 2

Posted on August 13, 2024 by rpflee

Euler problem 21.2.1

primes :: [Integer]
primes = 2 : filter (null . tail . primeFactors) [3, 5 ..]

primeFactors :: Integer -> [Integer]
primeFactors n = factor n primes
  where
    factor n (p : ps)
      | p * p > n = [n]
      | n `mod` p == 0 = p : factor (n `div` p) (p : ps)
      | otherwise = factor n ps

groupFactors :: [Integer] -> [[Integer]]
groupFactors = gf []
  where
    gf acc lst
      | null lst = reverse acc
      | null acc = gf [[p,1]] ps
      --
      | p == head (head acc) =
        gf ([p, head (tail (head acc)) + 1]:tail acc) ps
      --  
      | otherwise = gf ([p,1]:acc) ps
      where
        p = head lst
        ps = tail lst

generateDivisors :: Integral b => [[b]] -> [b]
generateDivisors xs = go xs 1
  where
    go [] acc = [acc]
    go (pe:ps) acc = concat [go ps (acc*p^e) | e <- [0..n]]
      where
        p = head pe
        n = pe !! 1

sumProperDivisors :: Integer -> Integer
sumProperDivisors n
  = -n + sum (generateDivisors
              (groupFactors (primeFactors n)))

amicableNumbers :: Integer -> [Integer]
amicableNumbers limit
  = [a | a <- [1..(limit-1)],
      let b = sumProperDivisors a, 
            a == sumProperDivisors b,
            a /= b]

λ> :set +s
λ> sum (amicableNumbers 10000)
31626
(0.35 secs, 511,950,576 bytes)
λ> sum (amicableNumbers 100000)
852810
(4.73 secs, 6,902,354,168 bytes)
λ> sum (amicableNumbers 1000000)
27220963
(66.07 secs, 93,880,279,320 bytes)
λ>

— Me@2024-08-11 10:40:06 AM

Euler problem 21.1

Posted on August 6, 2024 by rpflee

(defmacro sum (lst)
  `(reduce #'+ ,lst))

(defun proper-divisors (n)
  (when (> n 1)  
    (let ((divisors '())
          (limit (floor (sqrt n))))  
      (loop :for i :from 1 :to limit
            :when (zerop (mod n i))  
              :do (progn
                    (push i divisors)  
                    (when (/= n (floor n i))  
                      (push (floor n i)
                            divisors))))  
      (remove-duplicates (sort divisors #'<)
                         :test
                         #'equal))))

(defmacro sum-proper-divisors (n)
  `(sum (proper-divisors ,n)))

(defun amicable-numbers (limit)
  (let ((amicable-pairs '()))
    (loop :for a :from 2 :below limit
          :do (let* ((b (sum-proper-divisors a))
                     (c (sum-proper-divisors b)))
                (when (and (or (< b a)
                               (>= b limit))
                           (= a c))                      
                  (push a amicable-pairs)                 
                  (when (< b limit)
                    (push b amicable-pairs)))))
    (remove-duplicates amicable-pairs
                       :test
                       #'equal)))

(sum (amicable-numbers 10000))

 
CL-USER> (sum (amicable-numbers 10000))
31626
CL-USER>

— Me@2024-08-06 03:47:01 PM

Zsh, 3

Posted on August 1, 2024 by rpflee

1. Assuming you have already installed the Nix package manager on Ubuntu 22.04 or later, type the following command into the terminal:

nix-env -iA nixpkgs.zsh-autocomplete

2. Open the Zsh configuration file:

~/.zshrc

Add the following lines to it:

source ~/.nix-profile/share/zsh-autocomplete/zsh-autocomplete.plugin.zsh
 
bindkey -M menuselect '\e' undo

— Me@2024-01-23 08:52:05 AM

World Cup 94, 2

Posted on July 18, 2024 by rpflee

Find the sum of the digits in the number $\displaystyle{100!}$ .

import Data.Char ( digitToInt )

p_20 = sum
       $ map digitToInt
       $ show $ product [1..100]

λ> p_20
648

— Haskell official

— Me@2024-07-17 03:44:42 PM

Batman: Return of the Joker

Posted on June 26, 2024 by rpflee

Euler problem 20.1