Project Euler - Problem 7 - Tcl

#By listing the first six prime numbers: 2, 3, 5, 7, 11, and 13, we can see that the 6th prime is 13.
#What is the 10001st prime number?
proc problem7-v2 {} {
 # Much faster.
 #REMARK: Based on problem-3
 set primes [list 2 3]
 set current_number 5
 set primes_found 2

 set finished FALSE
 while { !$finished } {

  set is_prime TRUE
  foreach prime $primes {
   if { ( $current_number % $prime ) == 0  } {
    set is_prime FALSE
    break
   }

   if { $prime >  ($current_number / 2) } {
    # Can't be bigger than factor 2!
    break
   }
  }

  if { $is_prime } {
   incr primes_found 1
   set last_prime $current_number
   lappend primes $last_prime
  }

  set finished [expr $primes_found == 10001]

  incr current_number 2
 }

 puts "solution-7: [lindex $primes end]"
}

# solution-7: solution-7: 104743

Project Euler - Problem 6 - Tcl

#The sum of the squares of the first ten natural numbers is,
#1^2 + 2^2 + ... + 10^2 = 385
#
#The square of the sum of the first ten natural numbers is,
#(1 + 2 + ... + 10)^2 = 55^2 = 3025
#
#Hence the difference between the sum of the squares of the first ten natural numbers and the square of the sum is 3025 - 385 = 2640.
#
#Find the difference between the sum of the squares of the first one hundred natural numbers and the square of the sum.
proc problem6 {} {
 set sum_of_squares 0
 set squares_of_sum 0

 for { set idx 1 } { $idx <= 100 } {incr idx} {
  set sum_of_squares [expr $sum_of_squares + ($idx * $idx)]
  set squares_of_sum [expr $squares_of_sum + $idx ]
 }

 set squares_of_sum [expr $squares_of_sum*$squares_of_sum]

 puts "Solution-6: [expr $squares_of_sum - $sum_of_squares]"
}

#Solution-6: 25164150

Project Euler - Problem 4 - Tcl

#A palindromic number reads the same both ways. The largest palindrome made from the product of two 2-digit numbers is 9009 = 91  99.
#Find the largest palindrome made from the product of two 3-digit numbers.
proc problem4 {} {
 set palindrom_found FALSE
 set current_palindrom [expr 999*999]

 while { $palindrom_found == FALSE } {
  set current_palindrom [next_polindrom $current_palindrom -1]

  for { set idx 999 } { $idx > 900 } {incr idx -1} {
   if { ( $current_palindrom % $idx ) == 0   &&   ($current_palindrom / $idx) < 1000 } {
    puts "$idx*[expr $current_palindrom / $idx]=$current_palindrom"
    set palindrom_found TRUE
    break
   }
  }
 }
}

#****f* math/next_polindrom
# FUNCTION
#  Generates the next polindrom according to a given polindrom.
#
# INPUTS
#  pre_polindrom:
#   * TBD
#  direction:
#   * (+n) - next (n) polindrom up
#   * (-n) - next (n) polindrom down
#
# RESULT
#  * int - The consecutive (n) polinom from the given number/polinom.
#  * {} - error with parameters or none found.
#
# EXAMPLE
#  TBD
#
# NOTES
# * Good for solving problem-4. Jumps from 100000 to 9999 (see BUGS).
#
# BUGS
#  * Wrong sequance: {... 102201 101101 100001 9999 9889 9779 ... }
#
# SYNOPSIS
proc next_polindrom { pre_polindrom direction } {
 # SOURCE
 # E.g. pre_polindrom ==> 123000
 set polindrom_len [expr round( ceil( log10( $pre_polindrom ))) ]
 set polindrom_mid_len [expr ($polindrom_len / 2) + ($polindrom_len % 2)]
 set digits_to_align [expr $polindrom_len - $polindrom_mid_len]

 set polindrom_core $pre_polindrom  ; # E.g. polindrom_core ==> 123000
 while { $digits_to_align > 0} {
  set polindrom_core [expr $polindrom_core / 10]

  incr digits_to_align -1
 }  ; # E.g. polindrom_core ==> 123

 incr polindrom_core $direction  ; # E.g. (of +1): polindrom_core ==> 124

 set splited_polindrom_core [split $polindrom_core {}]  ; # E.g. splited_polindrom_core ==> {1 2 3}

 set splited_reversed_polindrom_core [lreverse $splited_polindrom_core]  ; # E.g. splited_reversed_polindrom_core ==> {3 2 1}
 set splited_reversed_polindrom_core [lrange $splited_reversed_polindrom_core [expr $polindrom_len % 2] end]  ; # E.g. for 123000: {3 2 1} ==> {3 2 1}, for 12300: {3 2 1} ==> {2 1}
 set reversed_polindrom_core [join $splited_reversed_polindrom_core {}]  ; # E.g. splited_reversed_polindrom_core ==> {321}

 set next_polinom "$polindrom_core$reversed_polindrom_core"

 return $next_polinom
 ######
}

#Solution-4: 993*913=906609

Project Euler - Problem 5 - Tcl

#2520 is the smallest number that can be divided by each of the numbers from 1 to 10 without any remainder.
#What is the smallest positive number that is evenly divisible by all of the numbers from 1 to 20?
proc problem5 {} {
 # REMARK: Runs forever :)
 set dividers [list ]
 for { set idx 20 } { $idx >= 2 } {incr idx -1} {
  lappend dividers $idx
 }
 set largest_divider 20

 set divisible FALSE
 set current_number 20

 while { ! $divisible } {
  incr current_number $largest_divider

  set divisible TRUE
  foreach divider $dividers {
   if {( $current_number % $divider ) != 0} {
    set divisible FALSE
    break
   }
  }
 }

 foreach divider $dividers {
  puts "$current_number / $divider = [expr $current_number / $divider] + [expr $current_number % $divider]/$divider"
 }

 return $current_number
}

#2520 is the smallest number that can be divided by each of the numbers from 1 to 10 without any remainder.
#What is the smallest positive number that is evenly divisible by all of the numbers from 1 to 20?
proc problem5-v2 {} {
 # REMARK: will get me very fast to the wanted number
 set largest_divider 1
 set dividers [list ]

 for { set idx 20 } { $idx >= 2 } {incr idx -1} {
  set largest_divider [expr $largest_divider * $idx]
  lappend dividers $idx
 }
 puts "largest divider=$largest_divider"

 foreach divider $dividers {
  while {( $largest_divider % $divider ) == 0} {
   set largest_divider [expr $largest_divider / $divider]
  }

  set largest_divider [expr $largest_divider * $divider]
 }

 foreach divider $dividers {
  puts "$largest_divider / $divider = [expr $largest_divider / $divider] + [expr $largest_divider % $divider]/$divider"
 }

 return $largest_divider  ;# == 9699690
}

proc problem5-v3 {} {
 # REMARK: Based on v2, all we need is to correct the results manually.
 set largest_divider [expr 9699690*4*3*2]

 set dividers [list ]
 
  for { set idx 20 } { $idx >= 2 } {incr idx -1} {
   lappend dividers $idx
  }
 
 
 foreach divider $dividers {
  puts "$largest_divider / $divider = [expr $largest_divider / $divider] + [expr $largest_divider % $divider]/$divider"
 }

}

# solution-4: 232792560

Project Euler - Problem 3 - Tcl

#The prime factors of 13195 are 5, 7, 13 and 29.
#What is the largest prime factor of the number 600851475143 ?
proc problem3 {} {
 set target_number 600851475143
 set primes [list 2 3]
 set current_number 5

 # let's speed things up a little...
 foreach prime $primes {
  while { ( $target_number % $prime ) == 0  } {
   set target_number [expr ($target_number / $prime) ]
  }
 }

 set finished FALSE
 while { !$finished } {

  set is_prime TRUE
  foreach prime $primes {
   if { ($current_number % $prime) == 0  } {
    set is_prime FALSE
    break
   }
  }

  if { $is_prime } {
   set last_prime $current_number
   lappend primes $last_prime

   while { ( $target_number % $last_prime ) == 0  } {
    set target_number [expr ($target_number / $last_prime) ]
   }
  }

  set finished [expr ($target_number == 1)]

  incr current_number 2
 }

 return [lindex $primes end]
}

# solution-3: 6857

Project Euler - Problem 2 - Tcl

#Each new term in the Fibonacci sequence is generated by adding the previous two terms. By starting with 1 and 2, the first 10 terms will be:
#1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
#By considering the terms in the Fibonacci sequence whose values do not exceed four million, find the sum of the even-valued terms.
proc problem2 {} {
 set term  2
 set term-1  1
 set sum  0

 while {$term <= 4000000} {
  if {($term % 2) == 0} {
   incr sum $term
  }

  set tmp  ${term-1}
  set term-1  $term
  set term  [expr $term + $tmp]
 }
 
 return $sum
}
# solution-2: 4613732

Project Euler - Problem 1 - Tcl

# If we list all the natural numbers below 10 that are multiples of 3 or 5, we get 3, 5, 6 and 9. The sum of these multiples is 23.
# Find the sum of all the multiples of 3 or 5 below 1000.
proc Problem1 {} {

 set items {}

 for {set idx 3} {$idx<1000} {incr idx 3} {
  lappend items $idx
 }

 for {set idx 5} {$idx<1000} {incr idx 5} {
  if { [lsearch $items $idx] < 0 } {
   lappend items $idx
  }
 }

 set rval 0
 foreach item $items {
  set rval [expr $rval + $item]
 }
  

 return $rval
}
# solution: 233168