# Nominal and Ordinal categorical variables

# Animals - by default the order does not matter
animals_vector <- c("Elephant", "Giraffe", "Donkey", "Horse")
factor_animals_vector <- factor(animals_vector)
factor_animals_vector

# Temperature
temperature_vector <- c("High", "Low", "High","Low", "Medium")
factor_temperature_vector <- factor(temperature_vector, order = TRUE, levels = c("Low", "Medium", "High"))
factor_temperature_vector

# order: outlines that the order matters
# levels: order of importance


#R para Kindergarten, sala de 2 años (pero con conceptos no triviales de analisis de datos)
#en la salita de 2 años NO se usan variables, tampoco sentencia if, loops ni funciones, ni parametros

rm(list=ls())

#entorno de ejecucion : PC local

#set working directory
#A un directorio correspondiente dentro de la máquina...
setwd("E:/UBA/2019-II/DM en Finanzas/Dropbox Prof/R")

#opcion nativa en R para cargar un dataset

#cargo los datos, forma estandar
t0       <-  Sys.time()
dataset  <-  read.table("../datasets/201902.txt", sep="\t")
t1       <-  Sys.time()

#calculo el tiempo de corrida, expresado en segundos
tcorrida <-  as.numeric(t1 - t0, units = "secs")
tcorridamin <-  as.numeric(tcorrida/60, units = "mins")

cat("tiempo carga dataset con read.table ",  tcorrida, " segundos\n" )
cat("tiempo carga dataset con read.table ",  tcorridamin, " minutos\n" )

#opcion con  libreria  data.table

#instalo el paquete, se hace una sola vez
install.packages( "data.table" )
#invoco a la libreria
library( "data.table" )

#cargo los datos, con la funcion File Read de la libreria data.table
t0       <-  Sys.time()
dataset  <-  data.table::fread("../datasets/201902.txt")
t1       <-  Sys.time()
tcorrida2 <-  as.numeric(t1 - t0, units = "secs")
tcorridamin2 <-  as.numeric(tcorrida2/60, units = "secs")

cat("tiempo carga dataset con fread ",  tcorrida2, " segundos\n" )
cat("tiempo carga dataset con fread ",  tcorridamin2, " minutos\n" )

#se observa una enorme diferencia en el tiempo de carga de un archivo
# A partir de ahora usamos la libreria  data.table para manejar los datasets

#Notar como se llamó a la funcion data.table::fread() especificando la libreria
#tambien se la podria haber llamado  directamente con fread()

#------------------------------------------------------------------------------
#operaciones basicas a un dataset usando  data.table

#cantidad de columnas
ncol( dataset )

#nombres de las columnas
#están nombradas de v1 a v170
colnames( dataset )

#cantidad de registros
nrow( dataset )

#ver que hay dentro
dataset

#ver un resumen
summary( dataset )

#si quiero que el summary quede en un archivo
setwd("E:/UBA/2019-II/DM en Finanzas/Dropbox Prof/work")

sink("summary-kinder.txt")
summary( dataset )
sink()

#calculo del promedio
mean(  dataset[  , mcuentas_saldo ] )
#otra forma
mean(  dataset$mcuentas_saldo )

#calculo de la mediana
median(  dataset[  , mcuentas_saldo ] )

#minimo y maximo de una columna
#tener en cuenta que esto incluye los saldos en pesos y dolares (pero expresados en pesos argentinos)
min(  dataset[  , mcuentas_saldo ] )
max(  dataset[  , mcuentas_saldo ] )

#ver un campo en particular Frequency Table
ftable( dataset$clase_ternaria )
ftable( dataset$Visa_cuenta_estado )
ftable( dataset$Master_cuenta_estado )

#Tabla de contingencia de un campo versus la clase
dcast( dataset, Visa_cuenta_estado  ~ clase_ternaria, length )
dcast( dataset, Master_cuenta_estado  ~ clase_ternaria, length )

#Tabla de contingencia de dos campos versus la clase
dcast( dataset, Visa_cuenta_estado + Master_cuenta_estado ~ clase_ternaria, length )

#-----------------------------------
#Verificar como los valores siguientes
#surgen directamente o son sumas
#de las celdas de la tabla de contingencia  dcast( dataset, Visa_cuenta_estado  ~ clase_ternaria, length )

#filtrar registros con condiciones logicas
#notar como se utiliza el ==
#notar que el AND  es  &
#notal que el OR   es  |

nrow(  dataset[  Visa_cuenta_estado==19, ] )
#la negacion
nrow(  dataset[  !(Visa_cuenta_estado==19), ] )

nrow(  dataset[  Visa_cuenta_estado==19 & clase_ternaria=="BAJA+2", ] )
nrow(  dataset[  Visa_cuenta_estado==10 & clase_ternaria=="BAJA+2", ] )
nrow(  dataset[  !(Visa_cuenta_estado==10) & clase_ternaria=="BAJA+2", ] )

#notar como se deben poner los parentesis porque el operador "&" tiene mas precedencia que el operador  "|"
nrow(  dataset[  (Visa_cuenta_estado==11 | Visa_cuenta_estado==12 ) & clase_ternaria=="BAJA+2", ] )
#en forma equivalente se puede hacer
nrow(  dataset[  (Visa_cuenta_estado %in% c( 11, 12))  & clase_ternaria=="BAJA+2", ] )

#la condicion para ver si un campo es nulo
nrow(  dataset[  is.na(Visa_cuenta_estado) & clase_ternaria=="BAJA+2", ] )

#la condicion para que un campo NO sea nulo
nrow(  dataset[  !is.na(Visa_cuenta_estado) & clase_ternaria=="BAJA+2", ] )

#-----------------------------------
#Filtrando columnas
#si ademas quiero filtrar columnas
dataset[  Visa_cuenta_estado==19 & clase_ternaria=="BAJA+2", c( "Visa_cuenta_estado", "Master_cuenta_estado", "mcuentas_saldo", "clase_ternaria" )]

#-----------------------------------
#crear un nuevo atributo en una data.table

#primero unos atributos basicos
#Notar como NO se usa la sentencia if
dataset[  , clase01 := 0 ]
dataset[ clase_ternaria=="BAJA+2",  clase01 := 1 ]

dataset[  , ganancia := -500]
dataset[ clase_ternaria=="BAJA+2",  ganancia := 19500 ]

#si le enviara estimulo a toda la base
sum(  dataset$ganancia )

#-----------------------------------
#aplico lo anterior a un predicado interesante
# Predicado1 =  Visa_cuenta_estado vale 11, 12 o 19  o  es NULO
#nada mal la ganancia de este simple predicado
sum(  dataset[ is.na( Visa_cuenta_estado ) |  (Visa_cuenta_estado %in% c(11,12,19) ),   ganancia ] )

#para que va a contratar la empresa a un Data Scientist si con este simpre predicado gana millones ?

#La cantidad de registros de ese predicado
nrow( dataset[ is.na( Visa_cuenta_estado ) |  (Visa_cuenta_estado %in% c(11,12,19) ), ] )

#La cantidad de positivos de ese predicado
sum( dataset[ is.na( Visa_cuenta_estado ) |  (Visa_cuenta_estado %in% c(11,12,19) ), clase01 ] )

#O lo puedo ver directamente con  dcast
#primero creo un nuevo atributo
dataset[  , predicado1 := 0 ]
dataset[ is.na( Visa_cuenta_estado ) |  (Visa_cuenta_estado %in% c(11,12,19) ) , predicado1 := 1 ]
dcast( dataset, predicado1 ~ clase_ternaria, length )

#-----------------------------------
#Ahora otre predicade buene y hermose

dataset[  , predicado2 := 0 ]
dataset[ tmovimientos_ultimos90dias <14  , predicado2 := 1 ]
sum( dataset[ predicado2==1, ganancia ] )

#Podria haber hecho
dataset[  , predicado3 := FALSE ]
dataset[ tmovimientos_ultimos90dias <14  , predicado3 := TRUE ]
sum( dataset[ predicado3==TRUE, ganancia ] )
sum( dataset[ (predicado3), ganancia ] )

#Ganancia muy buena para un predicado encontrado en la inspiracion ...

#------------------------------------------------------------------------------
#A pesar de estar en salita de 2 años, pasamos a conceptos mineros un poco mas avanzados
#jugando con la variable  tmovimientos_ultimos90dias

#cuantos valores distintos tiene tmovimientos_ultimos90dias
nrow( unique(  dataset[ , c("tmovimientos_ultimos90dias")] ) )
#o tambien podria hacer
length( unique( dataset$tmovimientos_ultimos90dias) )

#agrupo  en data.table
dataset[, sum(ganancia), by = tmovimientos_ultimos90dias]

#ahora que me nombre la nueva variable
dataset[, list( gan=sum(ganancia)), by = tmovimientos_ultimos90dias]

#ahora qen una tabla
tbl <- dataset[, list( gan=sum(ganancia)), by = tmovimientos_ultimos90dias]

#ahora acumulo
tbl[  , gan_acum := cumsum( gan ) ]

tbl[ 1:30, ]

#grafico

#hago el primer grafico
plot( tbl$tmovimientos_ultimos90dias,
      tbl$gan_acum,
      type="n",
      main="Ganancia ordenando por tmovimientos_ultimos90dias",
      xlab="tmovimientos_ultimos90dias",
      ylab="Ganancia Acumulada",
      pch=19)

lines( tbl$tmovimientos_ultimos90dias, tbl$gan_acum,   type="l" , col="blue", lwd=2)

#me fui de escala, ahora grafico los primeros
plot( tbl$tmovimientos_ultimos90dias[1:30],
      tbl$gan_acum[1:30],
      type="n",
      main="Ganancia ordenando por tmovimientos_ultimos90dias",
      xlab="tmovimientos_ultimos90dias",
      ylab="Ganancia Acumulada",
      pch=19)

lines( tbl$tmovimientos_ultimos90dias[1:30], tbl$gan_acum[1:30],   type="l" , col="blue", lwd=2)

#------------------------------------------------------------------------------
#ahora analizo la variable  mcuentas_saldo

#cuantos valores distintos tiene tmovimientos_ultimos90dias
nrow( dataset )
nrow( unique(  dataset[ , c("mcuentas_saldo")] ) )
nrow( dataset[ mcuentas_saldo==0, ] )

#este animal es de otra especie !

#primero veo si hay nulos
nrow(  dataset[ is.na( mcuentas_saldo ), ] )
#no los hay en este caso ! asi evito angustias de alumnos

min( dataset$mcuentas_saldo )
max( dataset$mcuentas_saldo )

#ordeno el dataset por la variable  mcuentas_saldo
#setorder es de la libreria  data.table
setorder(  dataset, mcuentas_saldo )

dataset[  ,      idx := seq( nrow(dataset) ) ]
dataset[  , pos_acum := cumsum( clase01 ) ]
dataset[  , neg_acum := cumsum( (1-clase01) ) ]
dataset[  , gan_acum := cumsum( ganancia ) ]

#veo como quedaron los campos
dataset[ 1:30,  c("mcuentas_saldo", "clase_ternaria", "idx", "clase01", "ganancia", "pos_acum", "neg_acum", "gan_acum" ) ]
#el minero con ojo avezado se da cuenta que hay muchos BAJA+1 y BAJA+2 al comienzo

#hago el primer grafico
plot( dataset$idx,
      dataset$gan_acum,
      type="n",
      main="Ganancia ordenando por mcuentas_saldo",
      xlab="registros",
      ylab="Ganancia Acumulada",
      pch=19)

lines( dataset$idx, dataset$gan_acum,   type="l" , col="blue", lwd=2)

#se fue de escala para ver el maximo,  me fijo solo en los 15000  primeros registros
plot( dataset$idx[1:15000],
      dataset$gan_acum[1:15000],
      type="n",
      main="Ganancia ordenando por mcuentas_saldo",
      xlab="registros ordenados por mcuentas_saldo",
      ylab="Ganancia Acumulada",
      pch=19)

lines( dataset$idx[1:15000], dataset$gan_acum[1:15000],   type="l" , col="blue", lwd=2)

#busco realmente donde esta el maximo
which.max(  dataset$gan_acum )

dataset[ which.max(  dataset$gan_acum ),  c("mcuentas_saldo", "clase_ternaria", "idx", "clase01", "ganancia", "pos_acum", "neg_acum", "gan_acum" ) ]

#-----------------------------------
#tecnicamente hablando, no es del todo correcto ordenar por un campo
#ya que para por ejemplo a dos registros con el mismo valor de mcuentas_saldo
#setoder los dejo en el orden inicial

#mi deseo es ordenar al azar cuando dos registros tienen el mismo valor de la variable

#genero un vector al valores al azar con distribucion uniforme en el intervalo real continuo [0,1]
runif( 10 )

#ahora agrego una variable al azar al dataset
dataset[  , azar1 :=  runif( nrow(dataset) ) ]

#ordeno primero por mcuentas_saldo  y cuando valen lo mismo por azar1
setorder(  dataset, mcuentas_saldo, azar1 )

which.max(  dataset$gan_acum )
dataset[ which.max(  dataset$gan_acum ),  c("mcuentas_saldo", "clase_ternaria", "idx", "clase01", "ganancia", "pos_acum", "neg_acum", "gan_acum" ) ]

graphics.off()

plot( dataset$idx[1:15000],
      dataset$gan_acum[1:15000],
      type="n",
      main="Ganancia ordenando por mcuentas_saldo",
      xlab="registros ordenados por mcuentas_saldo",
      ylab="Ganancia Acumulada",
      pch=19)

lines( dataset$idx[1:15000], dataset$gan_acum[1:15000],   type="l" , col="green", lwd=2)

#------------------------------------------------------------------------------
#ahora creamos variables nuevas

dataset[ , MV_cuenta_estado :=  pmax(Visa_cuenta_estado, Master_cuenta_estado, na.rm = TRUE) ]

#Notar que el maximo de una columna es max , sin embargo el maximo de dos valores es pmax
# na.rm  es  Remove NA's ,  si uno es nulo, se queda con el otro valor

dataset[  , Visa_mconsumototal_rel :=  Visa_mconsumototal  / Visa_mlimitecompra ]

#deduzca cual es la diferencia entre las siguientes dos instrucciones
dataset[  , MV_mconsumospesos  :=   Master_mconsumospesos +  Visa_mconsumospesos ]
dataset[  , MV_mconsumospesos2 :=   rowSums( cbind(Master_mconsumospesos, Visa_mconsumospesos), na.rm=TRUE) ]

#------------------------------------------------------------------------------
#ahora pasamos a dividir un dataset en training y testing, 70% y 30%
#como estamos en salita de 2 años, no parametrizamos

#una primera aproximacion
dataset[  ,  azar1 := runif( nrow(dataset) ) ]

dataset[ , fold := 0 ]
dataset[ azar1 > 0.7,  fold := 1 ]

tbl <- dcast( dataset, fold ~ clase_ternaria, length )
tbl[  , pos_idx :=  get("BAJA+2")/( get("BAJA+1")+get("BAJA+2")+get("CONTINUA")) ]
tbl

#ahora hacemos una muestra estratificada

#------------------------------------------------------------------------------
#eliminar columnas de un dataset
colnames( dataset )

dataset[ , MV_mconsumospesos:= NULL ]
colnames( dataset )

dataset[ , c("Visa_mconsumototal_rel","MV_mconsumospesos2"):= NULL ]
colnames( dataset )

#------------------------------------------------------------------------------

#Enhorabuena  !
#Si ha entendido todo hasta aqui, esta en condiciones de avanzar a la salita de 3 años del kindergarten


tests.verify: test performed on 2006.05.21

#### Test: tests.verify running hw.py 1.2
Hello, World! sin(1.2)=0.932039085967
CPU time of hw.py: 0.1 seconds on hplx30 i686, Linux

#### Test: tests.verify running datatrans1.py .datatrans_infile tmp1file
CPU time of datatrans1.py: 0.1 seconds on hplx30 i686, Linux

----- appending file tmp1file ------
0.1   5.36092e-01
0.2   3.12343e+00
0.3   5.87269e+00
0.4   3.12343e+00

#### Test: tests.verify running datatrans2.py .datatrans_infile tmp2file
CPU time of datatrans2.py: 0.1 seconds on hplx30 i686, Linux

----- appending file tmp2file ------
0.1   5.36092e-01
0.2   3.12343e+00
0.3   5.87269e+00
0.4   3.12343e+00

#### Test: tests.verify running datatrans3a.py .datatrans_infile tmp3afile
CPU time of datatrans3a.py: 0.4 seconds on hplx30 i686, Linux

----- appending file tmp3afile ------
0.1	0.536092
0.2	3.12343
0.3	5.87269
0.4	3.12343

#### Test: tests.verify running datatrans3b.py .datatrans_infile tmp3bfile
CPU time of datatrans3b.py: 0.4 seconds on hplx30 i686, Linux

----- appending file tmp3bfile ------
0.1 0.536092
0.2 3.12343
0.3 5.87269
0.4 3.12343

#### Test: tests.verify running convert1.py .convert_infile1
CPU time of convert1.py: 0.1 seconds on hplx30 i686, Linux

----- appending file tmp-measurements.dat ------
           0  0.00000e+00
         1.5  1.00000e-01
           3  2.00000e-01

----- appending file tmp-model1.dat ------
           0  1.00000e-01
         1.5  1.00000e-01
           3  2.00000e-01

----- appending file tmp-model2.dat ------
           0  1.00000e+00
         1.5  1.88000e-01
           3  2.50000e-01

#### Test: tests.verify running convert2.py .convert_infile1
y dictionary:
{'tmp-model2': [1.0, 0.188, 0.25], 'tmp-model1': [0.10000000000000001, 0.10000000000000001, 0.20000000000000001], 'tmp-measurements': [0.0, 0.10000000000000001, 0.20000000000000001]}
CPU time of convert2.py: 0.1 seconds on hplx30 i686, Linux

----- appending file tmp-measurements.dat ------
           0  0.00000e+00
         1.5  1.00000e-01
           3  2.00000e-01

----- appending file tmp-model1.dat ------
           0  1.00000e-01
         1.5  1.00000e-01
           3  2.00000e-01

----- appending file tmp-model2.dat ------
           0  1.00000e+00
         1.5  1.88000e-01
           3  2.50000e-01

#### Test: tests.verify running simviz1.py -A 5.0 -tstop 2 -case tmp4
CPU time of simviz1.py: 0.2 seconds on hplx30 i686, Linux

----- appending file tmp4/tmp4.i ------

        1
        0.7
        5
        y
        5
        6.28319
        0.2
        2
        0.05

----- appending file tmp4/tmp4.gnuplot ------

set title 'tmp4: m=1 b=0.7 c=5 f(y)=y A=5 w=6.28319 y0=0.2 dt=0.05';
plot 'sim.dat' title 'y(t)' with lines;

set size ratio 0.3 1.5, 1.0;
# define the postscript output format:
set term postscript eps monochrome dashed 'Times-Roman' 28;
# output file containing the plot:
set output 'tmp4.ps';
# basic plot command:
plot 'sim.dat' title 'y(t)' with lines;
# make a plot in PNG format:
set term png small;
set output 'tmp4.png';
plot 'sim.dat' title 'y(t)' with lines;

----- appending file tmp4/tmp4.ps (just 30 lines) ------
%!PS-Adobe-2.0 EPSF-2.0
%%Title: tmp4.ps
%%Creator: gnuplot 4.0 patchlevel 0
%%CreationDate: Sun May 21 12:04:22 2006
%%DocumentFonts: (atend)
%%BoundingBox: 50 50 590 302
%%Orientation: Portrait
%%EndComments
/gnudict 256 dict def
gnudict begin
/Color false def
/Solid false def
/gnulinewidth 5.000 def
/userlinewidth gnulinewidth def
/vshift -93 def
/dl {10.0 mul} def
/hpt_ 31.5 def
/vpt_ 31.5 def
/hpt hpt_ def
/vpt vpt_ def
/Rounded false def
/M {moveto} bind def
/L {lineto} bind def
/R {rmoveto} bind def
/V {rlineto} bind def
/N {newpath moveto} bind def
/C {setrgbcolor} bind def
/f {rlineto fill} bind def
/vpt2 vpt 2 mul def
/hpt2 hpt 2 mul def

#### Test: tests.verify running loop4simviz2.py c 5 30 10 -yaxis -0.7 0.7 -A 5.0 -tstop 2 -case tmp4 -noscreenplot
MPEG ENCODER STATS (1.5b)
------------------------
TIME STARTED:  Sun May 21 12:04:31 2006
MACHINE:  unknown
FIRST FILE:  ./tmp_0000.ppm
LAST FILE:  ./tmp_0002.ppm
PATTERN:  i
GOP_SIZE:  30
SLICES PER FRAME:  1
RANGE:  +/-10
PIXEL SEARCH:  HALF
PSEARCH:  LOGARITHMIC
BSEARCH:  CROSS2
QSCALE:  8 10 25
REFERENCE FRAME:  ORIGINAL

Creating new GOP (closed = T) before frame 0
FRAME 0 (I):  0 seconds  (4654800 bits/s output)
FRAME 1 (I):  0 seconds  (4792800 bits/s output)
FRAME 2 (I):  0 seconds  (4861920 bits/s output)

TIME COMPLETED:  Sun May 21 12:04:32 2006
Total time:  1 seconds

-------------------------
*****I FRAME SUMMARY*****
-------------------------
  Blocks:     5772     (476670 bits)     (   82 bpb)
  Frames:        3     (476984 bits)     (158994 bpf)     (99.8% of total)
  Compression:   74:1     (   0.3228 bpp)
  Seconds:          0     (   4.8649 fps)  (  2396160 pps)  (     9360 mps)
---------------------------------------------
Total Compression:   74:1     (   0.3234 bpp)
Total Frames Per Second:  3.000000 (5772 mps)
CPU Time:  4.864865 fps     (9359 mps)
Total Output Bit Rate (30 fps):  4778800 bits/sec
MPEG file created in :  movie.mpeg

======FRAMES READ:  3
gs -q -dBATCH -dNOPAUSE -sDEVICE=ppm  -sOutputFile=tmp_0000.ppm tmp_c_5/tmp_c_5.ps
tmp_c_5/tmp_c_5.ps transformed via gs to tmp_0000.ppm (1503 Kb)
gs -q -dBATCH -dNOPAUSE -sDEVICE=ppm  -sOutputFile=tmp_0001.ppm tmp_c_15/tmp_c_15.ps
tmp_c_15/tmp_c_15.ps transformed via gs to tmp_0001.ppm (1503 Kb)
gs -q -dBATCH -dNOPAUSE -sDEVICE=ppm  -sOutputFile=tmp_0002.ppm tmp_c_25/tmp_c_25.ps
tmp_c_25/tmp_c_25.ps transformed via gs to tmp_0002.ppm (1503 Kb)
mpeg movie in output file movie.mpeg
running python simviz2.py -yaxis -0.7 0.7 -A 5.0 -tstop 2 -case tmp4 -noscreenplot -c 5 -case tmp_c_5
running python simviz2.py -yaxis -0.7 0.7 -A 5.0 -tstop 2 -case tmp4 -noscreenplot -c 15 -case tmp_c_15
running python simviz2.py -yaxis -0.7 0.7 -A 5.0 -tstop 2 -case tmp4 -noscreenplot -c 25 -case tmp_c_25
converting PNG files to animated GIF:
convert -delay 50 -loop 1000 tmp_c_5/tmp_c_5.png tmp_c_15/tmp_c_15.png tmp_c_25/tmp_c_25.png tmp_c.gif
converting PostScript files to an MPEG movie:
ps2mpeg.py tmp_c_5/tmp_c_5.ps tmp_c_15/tmp_c_15.ps tmp_c_25/tmp_c_25.ps
epsmerge -o tmp_c_runs.ps -x 2 -y 3 -par tmp_c_5/tmp_c_5.ps tmp_c_15/tmp_c_15.ps tmp_c_25/tmp_c_25.ps
CPU time of loop4simviz2.py: 8.3 seconds on hplx30 i686, Linux

----- appending file tmp_c_runs.html ------

c=5

c=15

c=25

Movie

MPEG Movie

#### Test: tests.verify running NumPy_basics.py
zeros(n, Float): <type 'array'> d [ 0.  0.  0.  0.  0.  0.  0.  0.  0.  0.]
zeros(n) <type 'array'> l [0 0 0 0 0 0 0 0 0 0]
arrayrange(-5, 5, 0.5) <type 'array'> d [-5.  -4.5 -4.  -3.5 -3.  -2.5 -2.  -1.5 -1.  -0.5  0.   0.5  1.   1.5  2.
       2.5  3.   3.5  4.   4.5  5. ]
y = sin(x/2.0)*3.0: <type 'array'> d [-1.79541643 -2.33421959 -2.72789228 -2.95195784 -2.99248496 -2.84695386
      -2.52441295 -2.04491628 -1.43827662 -0.74221188  0.          0.74221188
       1.43827662  2.04491628  2.52441295  2.84695386  2.99248496  2.95195784
       2.72789228  2.33421959  1.79541643]
pl = [0, 1.2, 4, -9.1, 5, 8]; array(pl, typecode=Float) <type 'array'> [ 0.   1.2  4.  -9.1  5.   8. ]

creating arrays of length 1E+06 ...
fromfunction took 0.66 s and arange&sin took 0.39 s for length 1000000
1.2
[  0.  10.]
[[  0.   1.   2.   3.   4.   5.]
 [  6.   7.   8.   9.  10.  11.]
 [ 12.  13.  14.  15.  16.  17.]
 [ 18.  19.  20.  21.  22.  23.]
 [ 24.  25.  26.  27.  28.  29.]]
[[  6.   8.  10.]
 [ 12.  14.  16.]]
[[  2.   4.]
 [ 20.  22.]]
[[  2.   4.]
 [ 20.  22.]]
a[0,0]=2  a[0,1]=6  a[0,2]=12
a[1,0]=4  a[1,1]=12  a[1,2]=24
a.shape = (2,3); a= [[  2.   6.  12.]
 [  4.  12.  24.]]
a.shape = (size(a),); a= [  2.   6.  12.   4.  12.  24.]
b = 3*a - 1; b = clip(b, 0.1, 1.0E+20); c = cos(b) [  5.  17.  35.  11.  35.  71.] [ 0.28366219 -0.27516334 -0.90369221  0.0044257  -0.90369221 -0.30902273]
in-place operations:
multiply(a, 3.0, a); a= [  6.  18.  36.  12.  36.  72.]
subtract(a, 1.0, a); a= [  5.  17.  35.  11.  35.  71.]
divide  (a, 3.0, a); a= [  1.66666667   5.66666667  11.66666667   3.66666667  11.66666667  23.66666667]
add     (a, 1.0, a); a= [  2.66666667   6.66666667  12.66666667   4.66666667  12.66666667  24.66666667]
power   (a, 2.0, a); a= [   7.11111111   44.44444444  160.44444444   21.77777778  160.44444444
       608.44444444]
a *= 3.0; a= [   21.33333333   133.33333333   481.33333333    65.33333333   481.33333333
       1825.33333333]
a -= 1.0; a= [   20.33333333   132.33333333   480.33333333    64.33333333   480.33333333
       1824.33333333]
a /= 3.0; a= [   6.77777778   44.11111111  160.11111111   21.44444444  160.11111111
       608.11111111]
a += 1.0; a= [   7.77777778   45.11111111  161.11111111   22.44444444  161.11111111
       609.11111111]
a **= 2.0; a= [  6.04938272e+01   2.03501235e+03   2.59567901e+04   5.03753086e+02
        2.59567901e+04   3.71016346e+05]
a[2:4] = -1; a[-1] = a[0]; a= [[ 0.   1.2  4. ]
 [ 0.   1.2  4. ]]
a.shape = (3,2); a[:,0] [ 0.   4.   1.2]
a[:,1::2] [[ 1.2]
 [ 0. ]
 [ 4. ]]
transpose(a):  [[ 0.   4.   1.2]
 [ 1.2  0.   4. ]]
b array entries are of type Float so no casting is necessary
arrayrange(-5, 5, 0.5); variable type=<type 'array'> typecode=d
arrayrange(-5, 5, 1); variable type=<type 'array'> typecode=l
arrayrange(-5.0, 5, 1); variable type=<type 'array'> typecode=d
arrayrange(-5, 5, 0.5, Complex); variable type=<type 'array'> typecode=D
real part of x: [-5.  -4.5 -4.  -3.5 -3.  -2.5 -2.  -1.5 -1.  -0.5  0.   0.5  1.   1.5  2.
       2.5  3.   3.5  4.   4.5]
imaginary part of x: [ 0.  0.  0.  0.  0.  0.  0.  0.  0.  0.  0.  0.  0.  0.  0.  0.  0.  0.  0.
       0.]
eval(file.read()) works
read from binary (pickled) file: b1= [[  1.   2.]
 [ 11.  12.]] b2= [[  4.   5.]
 [ 14.  15.]]
read from binary file: b= [[  1.   2.   3.   4.   5.   6.   7.   8.   9.  10.]
 [ 11.  12.  13.  14.  15.  16.  17.  18.  19.  20.]]

--------- random numbers -------------

random number on (0,1): 0.723068520556
unform random number on (-1,1): -0.874106242503
N(0,1) uniform random number: 1.42433423327
mean of 10000 random uniform random numbers:
on (0,1): 0.49683461788 (should be 0.5)
on (-1,1): -0.00210852790364 (should be 0)
generated 10000 N(0,1) samples with
mean 0.00870529 and st.dev. 0.993361 using RandomArray.normal
probability N(0,1) < 1.5: 0.93

--------- linear algebra -------------

correct solution
correct solution
LinearAlgebra.determinant(A) = 1.19047619048e-05
B is the inverse of A, check ||A*B-I|| = 0, result: 7.46661081945e-13
det(A)=1.19048e-05
eigenvalue 10.6047 has corresponding vector
[ 0.47326857  0.49642858  0.51003386  0.51907706]
eigenvalue 0.215261 has corresponding vector
[ 0.7065385   0.08012043 -0.33075785 -0.62047023]
eigenvalue 0.017824 has corresponding vector
[ 0.06174023 -0.67059248 -0.07005871  0.73592503]
eigenvalue 0.000292584 has corresponding vector
[-0.04451401  0.33097206 -0.79128654  0.51219294]
A: [[ 3.          2.5         2.33333333  2.25      ]
 [ 3.          2.66666667  2.5         2.4       ]
 [ 3.          2.75        2.6         2.5       ]
 [ 3.          2.8         2.66666667  2.57142857]]
x: [ 0.   0.5  1.   1.5]
b: [ 6.95833333  7.43333333  7.725       7.92380952]
A*x = [[ 0.          1.25        2.33333333  3.375     ]
 [ 0.          1.33333333  2.5         3.6       ]
 [ 0.          1.375       2.6         3.75      ]
 [ 0.          1.4         2.66666667  3.85714286]]
b*x = [  0.           3.71666667   7.725       11.88571429]
matrixmultiply(A,x) = [ 6.95833333  7.43333333  7.725       7.92380952]
dot(A,x) = [ 6.95833333  7.43333333  7.725       7.92380952]
innerproduct(b,x) = 23.3273809524
dot(b,x) = 23.3273809524
Matrix M: Matrix([[ 3.        ,  2.5       ,  2.33333333,  2.25      ],
       [ 3.        ,  2.66666667,  2.5       ,  2.4       ],
       [ 3.        ,  2.75      ,  2.6       ,  2.5       ],
       [ 3.        ,  2.8       ,  2.66666667,  2.57142857]])
column vector xm: [[ 0. ]
 [ 0.5]
 [ 1. ]
 [ 1.5]]
M*xm = Matrix([[ 6.95833333],
       [ 7.43333333],
       [ 7.725     ],
       [ 7.92380952]])
row vector bm: Matrix([       [ 6.95833333,  7.43333333,  7.725     ,  7.92380952]])
bm*xm = Matrix([       [ 23.32738095]]) (inner product)
xm*xb = Matrix([[  0.        ,   0.        ,   0.        ,   0.        ],
       [  3.47916667,   3.71666667,   3.8625    ,   3.96190476],
       [  6.95833333,   7.43333333,   7.725     ,   7.92380952],
       [ 10.4375    ,  11.15      ,  11.5875    ,  11.88571429]]) (outer product)

performing some timings of "somefunc*" implementations...
 somefunc_NumPy (1 calls): elapsed=8.97336, CPU=8.09
 somefunc_NumPy2 (1 calls): elapsed=0.0820889, CPU=0.09
 somefunc_NumPy3 (1 calls): elapsed=0.118568, CPU=0.1
end of ./NumPy_basics.py
CPU time of NumPy_basics.py: 9.9 seconds on hplx30 i686, Linux

#### Test: tests.verify running leastsquares.py
CPU time of leastsquares.py: 0.6 seconds on hplx30 i686, Linux

#### Test: tests.verify running SciPy.py vectorization
control numbers (vectorize)  : 0.0 0.909307830212
control numbers (vectorize)  : 0.0 0.909307830212
control numbers (vectorize)  : 0.0 0.909307830212
control numbers (hand-coded) : 0.0 0.909307830212
CPU time of somefuncv: 6.5
CPU time of somefuncv2: 1.47
CPU time of somefuncv3: 6.61
CPU time of hand-coded function: 0.15
CPU time: vectorize(NumPy sin)/hand-coded = 43.3
CPU time: vectorize(math.sin)/hand-coded = 9.8
CPU time of SciPy.py: 15.4 seconds on hplx30 i686, Linux

#### Test: tests.verify running SciPy.py Oscillator 0.05
CPU time of odeint: 0.18
CPU time of oscillator: 0.18
CPU time of SciPy.py: 1.3 seconds on hplx30 i686, Linux

#### Test: tests.verify running SciPy.py integrate
2.0 2.22044604925e-14
2.0 2.22044604925e-14
CPU time of SciPy.py: 0.6 seconds on hplx30 i686, Linux

#### Test: tests.verify running ScientificPython.py
testing numbers with physical units:
arithmetics with PhysicalQuantity instances: 10.56 kg*km/s**2
converted to basic SI units: 10560.0 m*kg/s**2
converted to Mega Newton: 0.01056 MN
adding 0.1 kPa m^2: 0.01066 MN
str(F): 0.01066 MN
extract float value: 0.01066
10660.0 m*kg/s**2
0 Celcius in Farenheit: 32.0 degF

Testing automatic derivatives:
(function value, [d/dx, d/dy, d/dz]):
(6.0250000000000004, [3.0, -1.0, 1.0])
(sin(0), [cos(0)]): (0.0, [1.0])
3rd order derivatives of x^3: (1, [3], [[6]], [[[6]]])
(40, [3, -1, 20], [[0, 0, 0], [0, 0, 0], [0, 0, 20]])
d^2(somefunc)/dzdx: 0
d^2(somefunc)/dz^2: 20

testing interpolation:
interpolated: -0.942369478495  exact: -0.943548668636
interpolated derivative: 0.331095923354  exact: 0.331233920237
definite integral: 1.83753871398  exact: 1.83907152908
interpolation in 2D grid: 0.946401714384  exact value: 0.968105223808

testing nonlinear least squares:
([1.0864630262152011, 2.0402214672667118, 1.9767714371137151, 0.99937257343868868], 8.2409274338033922e-06)
guess: [ 1.  2.  2.  1.]
     deviation: [-0.0865 -0.0402  0.0232  0.0006]
guess: [ 0.95  1.95  1.95  0.95]
     deviation: [-0.171   0.1275  0.0785  0.0119]
guess: [ 0.9  1.9  1.9  0.9]
     deviation: [-0.1974  0.3622  0.1669  0.0193]
guess: [ 0.85  1.85  1.85  0.85]
     deviation: [-0.3122  0.4309  0.2334  0.0284]
guess: [ 1.2  2.2  2.2  1.2]
     deviation: [-0.9721 -0.6498 -0.0425 -0.0059]
guess: [ 0.75  1.75  1.75  0.75]
     deviation: [-0.6266  0.5119  0.3973  0.0569]

Testing statistical computations:
mean=1.00  standard deviation=0.50  skewness=-0.0 median=1.00, kurtosis=3.01
histogram array:
[[ -1.2254e+00   1.1255e-04]
 [ -1.1365e+00   2.2511e-04]
 [ -1.0477e+00   6.7533e-04]
 [ -9.5885e-01   4.5022e-04]
 [ -8.7001e-01   2.2511e-04]
 [ -7.8116e-01   1.2381e-03]
 [ -6.9231e-01   2.3636e-03]
 [ -6.0347e-01   5.5152e-03]
 [ -5.1462e-01   8.6667e-03]
 [ -4.2578e-01   1.3619e-02]
 [ -3.3693e-01   2.5212e-02]
 [ -2.4809e-01   3.6468e-02]
 [ -1.5924e-01   5.2563e-02]
 [ -7.0394e-02   8.1039e-02]
 [  1.8452e-02   1.1818e-01]
 [  1.0730e-01   1.5679e-01]
 [  1.9614e-01   2.1712e-01]
 [  2.8499e-01   2.8206e-01]
 [  3.7383e-01   3.7075e-01]
 [  4.6268e-01   4.6429e-01]
 [  5.5153e-01   5.3497e-01]
 [  6.4037e-01   6.2389e-01]
 [  7.2922e-01   6.8411e-01]
 [  8.1806e-01   7.2800e-01]
 [  9.0691e-01   7.7516e-01]
 [  9.9575e-01   7.9452e-01]
 [  1.0846e+00   8.0465e-01]
 [  1.1734e+00   7.4162e-01]
 [  1.2623e+00   6.9075e-01]
 [  1.3511e+00   6.2344e-01]
 [  1.4400e+00   5.4533e-01]
 [  1.5288e+00   4.5866e-01]
 [  1.6177e+00   3.8629e-01]
 [  1.7065e+00   2.8836e-01]
 [  1.7954e+00   2.2061e-01]
 [  1.8842e+00   1.6467e-01]
 [  1.9731e+00   1.2167e-01]
 [  2.0619e+00   8.4754e-02]
 [  2.1507e+00   5.4476e-02]
 [  2.2396e+00   3.5117e-02]
 [  2.3284e+00   2.4312e-02]
 [  2.4173e+00   1.3507e-02]
 [  2.5061e+00   8.4416e-03]
 [  2.5950e+00   5.2901e-03]
 [  2.6838e+00   2.1385e-03]
 [  2.7727e+00   1.3507e-03]
 [  2.8615e+00   9.0044e-04]
 [  2.9504e+00   1.1255e-04]
 [  3.0392e+00   4.5022e-04]
 [  3.1281e+00   3.3766e-04]]
50 [-1.2254 -1.1365 -1.0477 -0.9589 -0.87   -0.7812 -0.6923 -0.6035 -0.5146
      -0.4258 -0.3369 -0.2481 -0.1592 -0.0704  0.0185  0.1073  0.1961  0.285
       0.3738  0.4627  0.5515  0.6404  0.7292  0.8181  0.9069  0.9958  1.0846
       1.1734  1.2623  1.3511  1.44    1.5288  1.6177  1.7065  1.7954  1.8842
       1.9731  2.0619  2.1507  2.2396  2.3284  2.4173  2.5061  2.595   2.6838
       2.7727  2.8615  2.9504  3.0392  3.1281]
50 [  1.1255e-04   2.2511e-04   6.7533e-04   4.5022e-04   2.2511e-04   1.2381e-03
        2.3636e-03   5.5152e-03   8.6667e-03   1.3619e-02   2.5212e-02
        3.6468e-02   5.2563e-02   8.1039e-02   1.1818e-01   1.5679e-01
        2.1712e-01   2.8206e-01   3.7075e-01   4.6429e-01   5.3497e-01
        6.2389e-01   6.8411e-01   7.2800e-01   7.7516e-01   7.9452e-01
        8.0465e-01   7.4162e-01   6.9075e-01   6.2344e-01   5.4533e-01
        4.5866e-01   3.8629e-01   2.8836e-01   2.2061e-01   1.6467e-01
        1.2167e-01   8.4754e-02   5.4476e-02   3.5117e-02   2.4312e-02
        1.3507e-02   8.4416e-03   5.2901e-03   2.1385e-03   1.3507e-03
        9.0044e-04   1.1255e-04   4.5022e-04   3.3766e-04]
CPU time of ScientificPython.py: 2.0 seconds on hplx30 i686, Linux

#### Test: tests.verify running commontasks.py
Hello Pipe World
./commontasks.py : cannot read file 'qqq'
An exception of type
  exceptions.IOError
occurred, with value
   [Errno 2] No such file or directory: 'qqq'
arglist= ['myarg1', 'displacement', 'tmp.ps']
filename= myarg1  plottitle= displacement  psfile= tmp.ps
arglist= ['myarg1', 'displacement', 'tmp.ps', 'myvar2']
entry is  myarg1
entry is  displacement
entry is  tmp.ps
entry is  myvar2
In-place manipulation of array entries:
A[0]=1.2
A[1]=-3.4
A[2]=5.5
A[3]=-9
A[4]=100
No negative numbers:
A[0]=1.2
A[1]=0
A[2]=5.5
A[3]=0
A[4]=100
a 'foreach'-type loop does not work:
A[0]=1.2
A[1]=-3.4
A[2]=5.5
A[3]=-9
A[4]=100

split with re.split:
words1[0] = "iteration"
words1[1] = "12:"
words1[2] = "eps="
words1[3] = "1.245E-05"

split with string.split instead:
words1[0] = "iteration"
words1[2] = "12:"
words1[4] = "eps="
words1[6] = "1.245E-05"
newline1 is now [ iteration#12:#eps=#1.245E-05 ]
words2[0]=.myc_12
words2[1]=displacement
words2[2]=u(x,3.1415)
words2[3]=  no upwinding
['white', 'space', 'of', 'varying', 'length']
['white', 'space', '', '', 'of', 'varying', '', '', '', 'length']
Yes, matched regex= <_sre.SRE_Match object at 0xb7b69138>
regex sub:
#!/usr/bin/env python
import sys, math       # load system and math module
r = float(sys.argv[1]) # extract the 1st command-line argument
s = math.sin(r)
print "Hello, World! sin(" + str(r) + ")=" + str(s)

Testing dictionaries:

len(myargs)= 6
The option --myopt is not registered
The option -9.9 is not registered
dictionary: cmlargs, key= -tstop  value= 6.1
dictionary: cmlargs, key= -c_in_H  value= 9.8
cmlargs['-c_in_H']=9.8
cmlargs['-tstop']=6.1

Python lacks auto convert of strings-numbers
a =  0.6
hw.py is a plain file
stat:  33261
stat:  205289
stat:  775
stat:  1
stat:  8029
stat:  18029
stat:  206
stat:  1148205909
stat:  1148199265
stat:  1148199265
hw.py is a regular file with 206 bytes and last accessed 1148205909
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/entries
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/.test1.c.svn-base
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/fdmgrid.py.svn-base
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/htmlsubst.py.svn-base
0.01Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/intervalre.py.svn-base
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/introre.py.svn-base
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/realre.py.svn-base
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/swap1.py.svn-base
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/swap2.py.svn-base
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/swap3.py.svn-base
0.01Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/tests.r.svn-base
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/tests.verify.svn-base
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/verify_log.htm.svn-base
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/verify_log_details.htm.svn-base
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/.test1.c
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/fdmgrid.py
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/htmlsubst.py
0.01Mb /home/hpl/work/scripting/trunk/src/py/regex/intervalre.py
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/introre.py
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/realre.py
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/swap1.py
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/swap2.py
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/swap3.py
0.01Mb /home/hpl/work/scripting/trunk/src/py/regex/tests.r
0.01Mb /home/hpl/work/scripting/trunk/src/py/regex/tests.v
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/tests.verify
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/verify_log.htm
0.00Mb /home/hpl/work/scripting/trunk/src/py/regex/verify_log_details.htm

version 3 of tree traversal: root= /home/hpl/work/scripting/trunk/src/py/regex
/home/hpl/work/scripting/trunk/src/py/regex/.test1.c is 0.000672 Mb
/home/hpl/work/scripting/trunk/src/py/regex/realre.py is 0.001521 Mb
/home/hpl/work/scripting/trunk/src/py/regex/verify_log.htm is 0.000322 Mb
/home/hpl/work/scripting/trunk/src/py/regex/swap1.py is 0.000448 Mb
/home/hpl/work/scripting/trunk/src/py/regex/swap2.py is 0.00101 Mb
/home/hpl/work/scripting/trunk/src/py/regex/swap3.py is 0.001352 Mb
/home/hpl/work/scripting/trunk/src/py/regex/intervalre.py is 0.005451 Mb
/home/hpl/work/scripting/trunk/src/py/regex/verify_log_details.htm is 0.001306 Mb
/home/hpl/work/scripting/trunk/src/py/regex/tests.r is 0.011983 Mb
/home/hpl/work/scripting/trunk/src/py/regex/tests.v is 0.011983 Mb
/home/hpl/work/scripting/trunk/src/py/regex/tests.verify is 0.000366 Mb
/home/hpl/work/scripting/trunk/src/py/regex/htmlsubst.py is 0.000649 Mb
/home/hpl/work/scripting/trunk/src/py/regex/fdmgrid.py is 0.002941 Mb
/home/hpl/work/scripting/trunk/src/py/regex/introre.py is 0.001889 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/entries is 0.003859 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/.test1.c.svn-base is 0.000672 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/swap1.py.svn-base is 0.000448 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/intervalre.py.svn-base is 0.005451 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/swap2.py.svn-base is 0.00101 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/introre.py.svn-base is 0.001889 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/verify_log.htm.svn-base is 0.000322 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/swap3.py.svn-base is 0.001352 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/realre.py.svn-base is 0.001521 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/verify_log_details.htm.svn-base is 0.001306 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/fdmgrid.py.svn-base is 0.002941 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/tests.verify.svn-base is 0.000366 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/htmlsubst.py.svn-base is 0.000649 Mb
/home/hpl/work/scripting/trunk/src/py/regex/.svn/text-base/tests.r.svn-base is 0.011983 Mb
creating mynewdir
removing mynewdir
leading text ['listitem1', 'listitem2']
another leading text ['listitem1', 'listitem2']
No leading text ['listitem1', 'listitem2']
No leading text /home/hpl
statistics: avg=$avg, min=$min, max=$max

before swap: v1= 1.3  v2= some text
after  swap: v1= 1.3  v2= some text
files of *.ps *.gif and *.py type:
tmp_c_runs.ps
tmp1.ps
tmp2.ps
tmp.ps
tmp_c.gif
NumPy_basics.py
hw.py
leastsquares.py
datatrans1.py
datatrans2.py
datatrans3.py
ScientificPython.py
datatrans-eff.py
datatrans3a.py
datatrans3b.py
datatrans3c.py
datatrans3d.py
loop4simviz1.py
loop4simviz2.py
datatrans3_err.py
commontasks.py
simviz1.py
simviz2.py
convert1.py
convert2.py
convert3.py
SciPy.py
Output of the command perl -pe '' hw.py was

#!/usr/bin/env python
import sys, math       # load system and math module
r = float(sys.argv[1]) # extract the 1st command-line argument
s = math.sin(r)
print "Hello, World! sin(" + str(r) + ")=" + str(s)
file= /usr/home/hpl/scripting/perl/intro/hw.pl
head= /usr/home/hpl/scripting/perl/intro
tail= hw.pl
dirname = /usr/home/hpl/scripting/perl/intro
basename= hw.pl

Yes! created tmp/some/tmp/tmp

Programming with classes:
MyBase: i= 5 j= 7
MySub: i= 7 j= 8 k= 9
i1 is MyBase
i2 is MySub
i2 is MyBase too
i1.__dict__: {'i': 5, 'j': 7}
i2.__dict__: {'i': 7, 'k': 9, 'j': 8}
Names: MyBase MyBase.write
dir(i1): ['__doc__', '__init__', '__module__', 'i', 'j', 'write']
dir(i2): ['__doc__', '__init__', '__module__', 'i', 'j', 'k', 'write']
some string
['__doc__', '__init__', '__module__', 'i', 'j', 'k', 'q', 'write']

multiple inheritance:
A.set
B.set
C.set
{'a': 2, 'c': 0, 'b': 3}
list[6] raises an exception
Exception type= exceptions.IndexError
Exception value= list index out of range
average= 2.0
average= Empty argument list in average
Exception type= Empty argument list in average
Exception value= None
Exception type= exceptions.IOError
Exception value= [Errno 2] No such file or directory: 'ppp'
item 0: -                     description: initial shape of u
item 1: t                     description: initial shape of H
item 2: s                     description: shape of u at time=2.5
curve1                description: initial shape of u
curve2                description: initial shape of H
curve3                description: shape of u at time=2.5
1.2 is greater than or equal to 100 (a is <type 'str'> and b is <type 'int'> )
1.2 is less than 100 (a is <type 'float'> and b is <type 'int'> )
testing string b < 100: error!
testing float(b) < 100: ok
{
   'a' : 4,
   'b' : {
       'c' : 'some',
       'd' : 77,
       },
   'e' : {
       'f' : {
           'g' : 1,
           'h' : 2,
           },
       'i' : 4,
       },
   },

double complex root=-1j
complex root=(66.0302268206-1.99862731095j), complex root=(-0.030226820552+0.998627310945j)
complex root=(2-2j), complex root=(-2+2j)
float root=2.0, float root=-2.0

regex:

[  just a string   with leading and trailing white space   ]
[just a string   with leading and trailing white space   ]
[just a string   with leading and trailing white space]

comments= []
comments= ['# a comment', '# another comment', '# third comment']
points2= [[ 0.          3.        ]
 [ 0.1         3.57883668]
 [ 0.2         4.03471218]
 [ 0.3         4.26407817]
 [ 0.4         4.19914721]
 [ 0.5         3.81859485]
 [ 0.6         3.15092636]
 [ 0.7         2.2699763 ]
 [ 0.8         1.28325171]
 [ 0.9         0.31495911]
 [ 1.         -0.51360499]
 [ 1.1        -1.10320415]
 [ 1.2        -1.39232922]
 [ 1.3        -1.36690931]
 [ 1.4        -1.06253328]
 [ 1.5        -0.558831  ]
 [ 1.6         0.03309841]
 [ 1.7         0.5882267 ]
 [ 1.8         0.98733573]
 [ 1.9         1.13583934]]
http://www.ifi.uio.no/~hpl/downloadme.dat
lines= ['Just a simple test for downloading files from the Internet.\n']
finished
CPU time of commontasks.py: 0.8 seconds on hplx30 i686, Linux


LISP Interpreter Run

[ Test new lisp & show how it works ]

aa [ initially all atoms eval to self ]

expression  aa
value       aa

nil [ except nil = the empty list ]

expression  nil
value       ()

'aa [ quote = literally ]

expression  (' aa)
value       aa

'(aa bb cc) [ delimiters are ' " ( ) [ ] blank \n ]

expression  (' (aa bb cc))
value       (aa bb cc)

(aa bb cc) [ what if quote omitted?! ]

expression  (aa bb cc)
value       aa

'car '(aa bb cc) [ here effect is different ]

expression  (' (car (' (aa bb cc))))
value       (car (' (aa bb cc)))

car '(aa bb cc) [ car = first element of list ]

expression  (car (' (aa bb cc)))
value       aa

car '((a b)c d)

expression  (car (' ((a b) c d)))
value       (a b)

car '(aa)

expression  (car (' (aa)))
value       aa

car aa [ ignore error ]

expression  (car aa)
value       aa

cdr '(aa bb cc) [ cdr = rest of list ]

expression  (cdr (' (aa bb cc)))
value       (bb cc)

cdr '((a b)c d)

expression  (cdr (' ((a b) c d)))
value       (c d)

cdr '(aa)

expression  (cdr (' (aa)))
value       ()

cdr aa [ ignore error ]

expression  (cdr aa)
value       aa

cadr '(aa bb cc) [ combinations of car & cdr ]

expression  (car (cdr (' (aa bb cc))))
value       bb

caddr '(aa bb cc)

expression  (car (cdr (cdr (' (aa bb cc)))))
value       cc

cons 'aa '(bb cc) [ cons = inverse of car & cdr ]

expression  (cons (' aa) (' (bb cc)))
value       (aa bb cc)

cons'(a b)'(c d)

expression  (cons (' (a b)) (' (c d)))
value       ((a b) c d)

cons aa nil

expression  (cons aa nil)
value       (aa)

cons aa ()

expression  (cons aa ())
value       (aa)

cons aa bb [ ignore error ]

expression  (cons aa bb)
value       aa

("cons aa) [ supply nil for missing arguments ]

expression  (cons aa)
value       (aa)

("cons '(aa) '(bb) '(cc)) [ ignore extra arguments ]

expression  (cons (' (aa)) (' (bb)) (' (cc)))
value       ((aa) bb)

atom ' aa [ is-atomic? predicate ]

expression  (atom (' aa))
value       true

atom '(aa)

expression  (atom (' (aa)))
value       false

atom '(  )

expression  (atom (' ()))
value       true

= aa bb [ are-equal-S-expressions? predicate ]

expression  (= aa bb)
value       false

= aa aa

expression  (= aa aa)
value       true

= '(a b)'(a b)

expression  (= (' (a b)) (' (a b)))
value       true

= '(a b)'(a x)

expression  (= (' (a b)) (' (a x)))
value       false

if true x y [ if ... then ... else ... ]

expression  (if true x y)
value       x

if false x y

expression  (if false x y)
value       y

if xxx x y [ anything not false is true ]

expression  (if xxx x y)
value       x

[ display intermediate results ]
cdr display cdr display cdr display '( a b c d e )

expression  (cdr (display (cdr (display (cdr (display (' (a b
            c d e))))))))
display     (a b c d e)
display     (b c d e)
display     (c d e)
value       (d e)

('lambda(x y)x 1 2) [ lambda expression ]

expression  ((' (lambda (x y) x)) 1 2)
value       1

('lambda(x y)y 1 2)

expression  ((' (lambda (x y) y)) 1 2)
value       2

('lambda(x y)cons y cons x nil 1 2)

expression  ((' (lambda (x y) (cons y (cons x nil)))) 1 2)
value       (2 1)

(if true  "car "cdr '(a b c)) [ function expressions ]

expression  ((if true car cdr) (' (a b c)))
value       a

(if false "car "cdr '(a b c))

expression  ((if false car cdr) (' (a b c)))
value       (b c)

('lambda()cons x cons y nil) [ function with no arguments ]

expression  ((' (lambda () (cons x (cons y nil)))))
value       (x y)

[ Here is a way to create an expression and then
  evaluate it in the current environment.  EVAL (see
  below) does this using a clean environment instead. ]
(display
cons "lambda cons nil cons display 'cons x cons y nil nil)

expression  ((display (cons lambda (cons nil (cons (display ('
             (cons x (cons y nil)))) nil)))))
display     (cons x (cons y nil))
display     (lambda () (cons x (cons y nil)))
value       (x y)

[ let ... be ... in ... ]

let x a cons x cons x nil [ first case, let x be ... in ... ]

expression  ((' (lambda (x) (cons x (cons x nil)))) a)
value       (a a)

x

expression  x
value       x

[ second case, let (f x) be ... in ... ]

let (f x) if atom display x x (f car x)
 (f '(((a)b)c))

expression  ((' (lambda (f) (f (' (((a) b) c))))) (' (lambda (
            x) (if (atom (display x)) x (f (car x))))))
display     (((a) b) c)
display     ((a) b)
display     (a)
display     a
value       a

f

expression  f
value       f

append '(a b c) '(d e f) [ concatenate-list primitive ]

expression  (append (' (a b c)) (' (d e f)))
value       (a b c d e f)

[ define "by hand" temporarily ]

let (cat x y) if atom x y cons car x (cat cdr x y)
    (cat '(a b c) '(d e f))

expression  ((' (lambda (cat) (cat (' (a b c)) (' (d e f)))))
            (' (lambda (x y) (if (atom x) y (cons (car x) (cat
             (cdr x) y))))))
value       (a b c d e f)

cat

expression  cat
value       cat

[ define "by hand" permanently ]

define (cat x y) if atom x y cons car x (cat cdr x y)

define      cat
value       (lambda (x y) (if (atom x) y (cons (car x) (cat (c
            dr x) y))))

cat

expression  cat
value       (lambda (x y) (if (atom x) y (cons (car x) (cat (c
            dr x) y))))

(cat '(a b c) '(d e f))

expression  (cat (' (a b c)) (' (d e f)))
value       (a b c d e f)

define x (a b c) [ define atom, not function ]

define      x
value       (a b c)

cons x nil

expression  (cons x nil)
value       ((a b c))

define x (d e f)

define      x
value       (d e f)

cons x nil

expression  (cons x nil)
value       ((d e f))

size abc [ size of S-expression in characters ]

expression  (size abc)
value       3

size ' ( a b c )

expression  (size (' (a b c)))
value       7

length ' ( a b c ) [ number of elements in list ]

expression  (length (' (a b c)))
value       3

length display bits ' a [ S-expression --> bits ]

expression  (length (display (bits (' a))))
display     (0 1 1 0 0 0 0 1 0 0 0 0 1 0 1 0)
value       16

length display bits ' abc [ extra character is \n ]

expression  (length (display (bits (' abc))))
display     (0 1 1 0 0 0 0 1 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 1 0
             0 0 0 1 0 1 0)
value       32

length display bits nil

expression  (length (display (bits nil)))
display     (0 0 1 0 1 0 0 0 0 0 1 0 1 0 0 1 0 0 0 0 1 0 1 0)
value       24

length display bits ' (a)

expression  (length (display (bits (' (a)))))
display     (0 0 1 0 1 0 0 0 0 1 1 0 0 0 0 1 0 0 1 0 1 0 0 1 0
             0 0 0 1 0 1 0)
value       32

[ plus ]
+ abc 15 [ not number --> 0 ]

expression  (+ abc 15)
value       15

+ '(abc) 15

expression  (+ (' (abc)) 15)
value       15

+ 10 15

expression  (+ 10 15)
value       25

- 10 15 [ non-negative minus ]

expression  (- 10 15)
value       0

- 15 10

expression  (- 15 10)
value       5

* 10 15 [ times ]

expression  (* 10 15)
value       150

^ 10 15 [ power ]

expression  (^ 10 15)
value       1000000000000000

< 10 15 [ less than ]

expression  (< 10 15)
value       true

< 10 10

expression  (< 10 10)
value       false

> 15 10 [ greater than ]

expression  (> 15 10)
value       true

> 10 10

expression  (> 10 10)
value       false

<= 15 10 [ less than or equal ]

expression  (<= 15 10)
value       false

<= 10 10

expression  (<= 10 10)
value       true

>= 10 15 [ greater than or equal ]

expression  (>= 10 15)
value       false

>= 10 10

expression  (>= 10 10)
value       true

= 10 15 [ equal ]

expression  (= 10 15)
value       false

= 10 10

expression  (= 10 10)
value       true

[ here not number isn't considered zero ]
= abc 0

expression  (= abc 0)
value       false

= 0003 3 [ other ways numbers are funny ]

expression  (= 3 3)
value       true

000099 [ leading zeros removed ]

expression  99
value       99

[ and numbers are constants ]
let x b cons x cons x nil

expression  ((' (lambda (x) (cons x (cons x nil)))) b)
value       (b b)

let 99 45 cons 99 cons 99 nil

expression  ((' (lambda (99) (cons 99 (cons 99 nil)))) 45)
value       (99 99)

define 99 45

define      99
value       45

cons 99 cons 99 nil

expression  (cons 99 (cons 99 nil))
value       (99 99)

[ decimal<-->binary conversions ]

base10-to-2 255

expression  (base10-to-2 255)
value       (1 1 1 1 1 1 1 1)

base10-to-2 256

expression  (base10-to-2 256)
value       (1 0 0 0 0 0 0 0 0)

base10-to-2 257

expression  (base10-to-2 257)
value       (1 0 0 0 0 0 0 0 1)

base2-to-10 '(1 1 1 1)

expression  (base2-to-10 (' (1 1 1 1)))
value       15

base2-to-10 '(1 0 0 0 0)

expression  (base2-to-10 (' (1 0 0 0 0)))
value       16

base2-to-10 '(1 0 0 0 1)

expression  (base2-to-10 (' (1 0 0 0 1)))
value       17

[ illustrate eval & try ]

eval display '+ display 5 display 15

expression  (eval (display (' (+ (display 5) (display 15)))))
display     (+ (display 5) (display 15))
display     5
display     15
value       20

try 0 display '+ display 5 display 15 nil

expression  (try 0 (display (' (+ (display 5) (display 15))))
            nil)
display     (+ (display 5) (display 15))
value       (success 20 (5 15))

try 0 display '+ debug 5 debug 15 nil

expression  (try 0 (display (' (+ (debug 5) (debug 15)))) nil)
display     (+ (debug 5) (debug 15))
debug       5
debug       15
value       (success 20 ())

[ eval & try use initial variable bindings ]

cons x nil

expression  (cons x nil)
value       ((d e f))

eval 'cons x nil

expression  (eval (' (cons x nil)))
value       (x)

try 0 'cons x nil nil

expression  (try 0 (' (cons x nil)) nil)
value       (success (x) ())

define five! [ to illustrate time limits ]
let (f x) if = display x 0 1 * x (f - x 1)
    (f 5)

define      five!
value       ((' (lambda (f) (f 5))) (' (lambda (x) (if (= (dis
            play x) 0) 1 (* x (f (- x 1)))))))

eval five!

expression  (eval five!)
display     5
display     4
display     3
display     2
display     1
display     0
value       120

[ by the way, numbers can be big: ]
let (f x) if = x 0 1 * x (f - x 1)
    (f 100) [ one hundred factorial! ]

expression  ((' (lambda (f) (f 100))) (' (lambda (x) (if (= x
            0) 1 (* x (f (- x 1)))))))
value       93326215443944152681699238856266700490715968264381
            62146859296389521759999322991560894146397615651828
            62536979208272237582511852109168640000000000000000
            00000000

[ time limit is nesting depth of re-evaluations
  due to function calls & eval & try ]

try 0 five! nil

expression  (try 0 five! nil)
value       (failure out-of-time ())

try 1 five! nil

expression  (try 1 five! nil)
value       (failure out-of-time ())

try 2 five! nil

expression  (try 2 five! nil)
value       (failure out-of-time (5))

try 3 five! nil

expression  (try 3 five! nil)
value       (failure out-of-time (5 4))

try 4 five! nil

expression  (try 4 five! nil)
value       (failure out-of-time (5 4 3))

try 5 five! nil

expression  (try 5 five! nil)
value       (failure out-of-time (5 4 3 2))

try 6 five! nil

expression  (try 6 five! nil)
value       (failure out-of-time (5 4 3 2 1))

try 7 five! nil

expression  (try 7 five! nil)
value       (success 120 (5 4 3 2 1 0))

try no-time-limit five! nil

expression  (try no-time-limit five! nil)
value       (success 120 (5 4 3 2 1 0))

define two* [ to illustrate running out of data ]
 let (f x) if = 0 x nil
           cons * 2 display read-bit (f - x 1)
     (f 5)

define      two*
value       ((' (lambda (f) (f 5))) (' (lambda (x) (if (= 0 x)
             nil (cons (* 2 (display (read-bit))) (f (- x 1)))
            ))))

try 6 two* '(1 0 1 0 1)

expression  (try 6 two* (' (1 0 1 0 1)))
value       (failure out-of-time (1 0 1 0 1))

try 7 two* '(1 0 1 0 1)

expression  (try 7 two* (' (1 0 1 0 1)))
value       (success (2 0 2 0 2) (1 0 1 0 1))

try 7 two* '(1 0 1)

expression  (try 7 two* (' (1 0 1)))
value       (failure out-of-data (1 0 1))

try no-time-limit two* '(1 0 1)

expression  (try no-time-limit two* (' (1 0 1)))
value       (failure out-of-data (1 0 1))

try 18
'let (f x) if = 0 x nil
           cons * 2 display read-bit (f - x 1)
     (f 16)
bits 'a

expression  (try 18 (' ((' (lambda (f) (f 16))) (' (lambda (x)
             (if (= 0 x) nil (cons (* 2 (display (read-bit)))
            (f (- x 1)))))))) (bits (' a)))
value       (success (0 2 2 0 0 0 0 2 0 0 0 0 2 0 2 0) (0 1 1
            0 0 0 0 1 0 0 0 0 1 0 1 0))

[ illustrate nested try's ]
[ most constraining limit wins ]

try 20
'cons abcdef try 10
'let (f n) (f display + n 1) (f 0) [infinite loop]
nil nil

expression  (try 20 (' (cons abcdef (try 10 (' ((' (lambda (f)
             (f 0))) (' (lambda (n) (f (display (+ n 1)))))))
            nil))) nil)
value       (success (abcdef failure out-of-time (1 2 3 4 5 6
            7 8 9)) ())

try 10
'cons abcdef try 20
'let (f n) (f display + n 1) (f 0) [infinite loop]
nil nil

expression  (try 10 (' (cons abcdef (try 20 (' ((' (lambda (f)
             (f 0))) (' (lambda (n) (f (display (+ n 1)))))))
            nil))) nil)
value       (failure out-of-time ())

try 10
'cons abcdef try 20
'let (f n) (f debug + n 1) (f 0) [infinite loop]
nil nil

expression  (try 10 (' (cons abcdef (try 20 (' ((' (lambda (f)
             (f 0))) (' (lambda (n) (f (debug (+ n 1))))))) ni
            l))) nil)
debug       1
debug       2
debug       3
debug       4
debug       5
debug       6
debug       7
debug       8
value       (failure out-of-time ())

try no-time-limit
'cons abcdef try 20
'let (f n) (f display + n 1) (f 0) [infinite loop]
nil nil

expression  (try no-time-limit (' (cons abcdef (try 20 (' (('
            (lambda (f) (f 0))) (' (lambda (n) (f (display (+
            n 1))))))) nil))) nil)
value       (success (abcdef failure out-of-time (1 2 3 4 5 6
            7 8 9 10 11 12 13 14 15 16 17 18 19)) ())

try 10
'cons abcdef try no-time-limit
'let (f n) (f display + n 1) (f 0) [infinite loop]
nil nil

expression  (try 10 (' (cons abcdef (try no-time-limit (' (('
            (lambda (f) (f 0))) (' (lambda (n) (f (display (+
            n 1))))))) nil))) nil)
value       (failure out-of-time ())

[ illustrate read-bit & read-exp ]

read-bit

expression  (read-bit)
value       out-of-data

read-exp

expression  (read-exp)
value       out-of-data

try 0 'read-bit nil

expression  (try 0 (' (read-bit)) nil)
value       (failure out-of-data ())

try 0 'read-exp nil

expression  (try 0 (' (read-exp)) nil)
value       (failure out-of-data ())

try 0 'read-exp bits 'abc

expression  (try 0 (' (read-exp)) (bits (' abc)))
value       (success abc ())

try 0 'read-exp bits '(abc def)

expression  (try 0 (' (read-exp)) (bits (' (abc def))))
value       (success (abc def) ())

try 0 'read-exp bits '(abc(def ghi)jkl)

expression  (try 0 (' (read-exp)) (bits (' (abc (def ghi) jkl)
            )))
value       (success (abc (def ghi) jkl) ())

try 0 'cons read-exp cons read-bit nil bits 'abc

expression  (try 0 (' (cons (read-exp) (cons (read-bit) nil)))
             (bits (' abc)))
value       (failure out-of-data ())

try 0 'cons read-exp cons read-bit nil append bits 'abc '(0)

expression  (try 0 (' (cons (read-exp) (cons (read-bit) nil)))
             (append (bits (' abc)) (' (0))))
value       (success (abc 0) ())

try 0 'cons read-exp cons read-bit nil append bits 'abc '(1)

expression  (try 0 (' (cons (read-exp) (cons (read-bit) nil)))
             (append (bits (' abc)) (' (1))))
value       (success (abc 1) ())

try 0 'read-exp bits '(a b c)

expression  (try 0 (' (read-exp)) (bits (' (a b c))))
value       (success (a b c) ())

try 0 'cons read-exp cons read-exp nil bits '(a b c)

expression  (try 0 (' (cons (read-exp) (cons (read-exp) nil)))
             (bits (' (a b c))))
value       (failure out-of-data ())

try 0 'cons read-exp cons read-exp nil
      append bits '(a b c) bits '(d e f)

expression  (try 0 (' (cons (read-exp) (cons (read-exp) nil)))
             (append (bits (' (a b c))) (bits (' (d e f)))))
value       (success ((a b c) (d e f)) ())

bits 'a [ to get characters codes ]

expression  (bits (' a))
value       (0 1 1 0 0 0 0 1 0 0 0 0 1 0 1 0)

try 0 'read-exp '(0 1 1 0  0 0 0 1) ['a' but no \n character]

expression  (try 0 (' (read-exp)) (' (0 1 1 0 0 0 0 1)))
value       (failure out-of-data ())

try 0 'read-exp '(0 1 1 0  0 0 0 1  0 0 0 0  1 0 1)[0 missing]

expression  (try 0 (' (read-exp)) (' (0 1 1 0 0 0 0 1 0 0 0 0
            1 0 1)))
value       (failure out-of-data ())

try 0 'read-exp '(0 1 1 0  0 0 0 1  0 0 0 0  1 0 1 0) [okay]

expression  (try 0 (' (read-exp)) (' (0 1 1 0 0 0 0 1 0 0 0 0
            1 0 1 0)))
value       (success a ())

[ if we get to \n reading 8 bits at a time,
  we will always interpret as a valid S-expression ]
try 0 'read-exp
      '(0 0 0 0 1 0 1 0) [nothing in record; only \n]

expression  (try 0 (' (read-exp)) (' (0 0 0 0 1 0 1 0)))
value       (success () ())

try 0 'read-exp '(1 1 1 1  1 1 1 1  [unprintable character]
                  0 0 0 0  1 0 1 0) [is deleted]

expression  (try 0 (' (read-exp)) (' (1 1 1 1 1 1 1 1 0 0 0 0
            1 0 1 0)))
value       (success () ())

bits () [ to get characters codes ]

expression  (bits ())
value       (0 0 1 0 1 0 0 0 0 0 1 0 1 0 0 1 0 0 0 0 1 0 1 0)

[ three left parentheses==>three right parentheses supplied ]
try 0 'read-exp '(0 0 1 0  1 0 0 0  0 0 1 0  1 0 0 0
                  0 0 1 0  1 0 0 0  0 0 0 0  1 0 1 0)

expression  (try 0 (' (read-exp)) (' (0 0 1 0 1 0 0 0 0 0 1 0
            1 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 1 0 1 0)))
value       (success ((())) ())

[ right parenthesis 'a'==>left parenthesis supplied ]
try 0 'read-exp '(0 0 1 0  1 0 0 1  0 1 1 0  0 0 0 1
                  0 0 0 0  1 0 1 0) [ & extra 'a' ignored ]

expression  (try 0 (' (read-exp)) (' (0 0 1 0 1 0 0 1 0 1 1 0
            0 0 0 1 0 0 0 0 1 0 1 0)))
value       (success () ())

[ 'a' right parenthesis==>'a' is seen & parenthesis ]
try 0 'read-exp '(0 1 1 0  0 0 0 1  0 0 1 0  1 0 0 1
                  0 0 0 0  1 0 1 0) [ is ignored ]

expression  (try 0 (' (read-exp)) (' (0 1 1 0 0 0 0 1 0 0 1 0
            1 0 0 1 0 0 0 0 1 0 1 0)))
value       (success a ())

End of LISP Run

Elapsed time is 1 seconds.


#' Summary function
#'
#' @param object object with "local_random_test" class
#' @param \dots additional arguments affecting the summary produced.
#'
#' @method summary local_random_test
#' @export
#'
summary.local_random_test <- function(object, ...) {
  rdinfo <- object$RD.info
  bwinfo <- object$bandwidth
  res <- object$estimate

  show <- paste0(
    "Local ATE by Local Random Approach\n\n",
    "RD Design Information\n",
    "Running variable: ", rdinfo$running.variable, "\n"
  )

  if (object$RD.info$assignment == "greater") {
    show <- paste0(
      show,
      "Assignment rule: 1[x >=", rdinfo$cutoff, "]\n\n"
    )
  } else {
    show <- paste0(
      show,
      "Assignment rule: 1[x <=", rdinfo$cutoff, "]\n\n"
    )
  }

  show <- paste0(
    show,
    "Test information \n"
  )

  if (object$bandwidth$global) {
    show <- paste0(
      show,
      "Use all observation: ", bwinfo$global, "\n"
    )
  } else {
    show <- paste0(
      show,
      "Use all observation: ", bwinfo$global, "\n",
      "Bandiwdth: [", bwinfo$bw[1] + rdinfo$cutoff, ",",
      bwinfo$bw[2] + rdinfo$cutoff, "]\n"
    )
  }

  show <- paste0(
    show,
    "Method of statistical test: ", res[[1]]$local.ate$method,
    "\n\n"
  )

  for (i in seq_len(length(res))) {
    show <- paste0(
      show,
      "Outcome variables: ", res[[i]]$outcome, "\n",
      "---------------------------------------------------------------\n",
      "    Treated                 Control             Local ATE      \n",
      "N    Mean   S.E.        N    Mean   S.E.    Estimate    P-value\n",
      "---------------------------------------------------------------\n",
      res[[i]]$observe$treat$N, "  ",
      sprintf("%1.2f", res[[i]]$observe$treat$mean),  "  ",
      sprintf("%1.2f", res[[i]]$observe$treat$se), "       ",
      res[[i]]$observe$control$N, "  ",
      sprintf("%1.2f", res[[i]]$observe$control$mean), "  ",
      sprintf("%1.2f", res[[i]]$observe$control$se), "     ",
      sprintf("%1.2f", res[[i]]$local.ate$estimate), "     ",
      sprintf("%1.2f", res[[i]]$local.ate$p.value), "\n",
      "---------------------------------------------------------------\n\n"
    )
  }

  cat(show)

}


# Reverse Complement Problem

seq <- "ACTGTTTCAGT"
seq_new <- strsplit(seq, "")[[1]]

comp <- c()
for (i in seq_new){
  if (i == "A"){
    comp <- c(comp, "T")
  }else if (i == "T"){
    comp <- c(comp, "A")
  }else if (i == "C"){
    comp <- c(comp, "G")
  }else if (i == "G"){
    comp <- c(comp, "C")
  }
}

rev_comp <- rev(comp)
rev_comp_new <- paste0(rev_comp, collapse = "")

print (rev_comp_new)


#! /usr/bin/Rscript
# license: BSD 3-Clause License
# author: https://github.com/ywd5
# version: 20210314

if("" == "get dependency"){
  require(magrittr); require(tibble); require(dplyr); require(stringr); require(purrr);
  require(pegas)
  require(questionr)
  require(digest)#; require(openssl);
}

if("" == "test codes"){
  ans <- list.files(pattern="^output\\.xml$", full.names=TRUE, recursive=TRUE) %>%
    grep(pattern="first run", x=., value=TRUE)
  tempo <- tempfile(); phased_loci <- vector(mode="list", length=length(ans)); for(i in 1:length(ans)){
    ans[i] %>% read_xml() %>% xml_child(search="phased_loci") %>% xml_contents() %>%
      as.character() %>% cat(., file=tempo, append=FALSE, sep="")
    phased_loci[[i]] <- pegas::read.loci(file=tempo, header=TRUE, row.names=1L)
  }; file.remove(tempo); remove(tempo, i);
  #
  load(file="../can delete, unphased_loci.rdata")
  locus_position <- unphased_loci$locus_position
  not_varied_loci <- unphased_loci$not_varied_loci
  remove(unphased_loci)
  # pegas::is.snp(phased_loci) # this code will treate triple-phase locus as not snp
  # phased_loci %>% pegas::rarefactionplot()
  # ?pegas::haplotype()
  # ?pegas::haplotype.loci()
  # haplo %>% ape::as.DNAbin()
  ExamineRarePhasedHaplotypes(phased_loci=phased_loci, locus_position=locus_position,
                              not_varied_loci=not_varied_loci)
}

message("ExamineRarePhasedHaplotypes() may be able to tackle (deal with, cope with, handle) ",
        "polyploid, but currently only support diploid")
# this function can work with snp and microsatellite loci

ExamineRarePhasedHaplotypes <- function(
  phased_loci, locus_position,
  not_varied_loci=base::rep("varied", times=length(locus_position))
){
  # control the input-------------------------------------------------------------------------------
  if(!is(object=phased_loci, class2="loci")){stop("phased_loci must be a loci object");}
  if(any(dim(phased_loci) == 0)){stop("phased_loci is empty");}
  pegas::is.phased(phased_loci) %>% {if(!all(.)){warning("seperators of haplotypes should be |, not /");}}
  if("" != "ensure data are from diploid"){
    getPloidy(phased_loci) %>% {any(. != 2)} %>% {if(.){stop("only diploid data are supported");}}
  }
  #
  if(!is.numeric(locus_position)){stop("locus_position must be integers");}
  locus_position %<>% as.integer() %>% base::sort()
  if(anyNA(locus_position)){stop("locus_position must be integers");}
  if(any(locus_position < 1L)){stop("locus_position can't be smaller than 1");}
  if(anyDuplicated(locus_position) != 0){stop("locus_position can't contain duplicated items");}
  #
  if(!is.character(not_varied_loci)){stop("not_varied_loci must be a character vector");}
  if(length(not_varied_loci) == 0){stop("not_varied_loci is empty");}
  if(anyNA(not_varied_loci)){stop("not_varied_loci can't contain NA");}
  # control the relationship among inputs-----------------------------------------------------------
  (ncol(phased_loci) != length(locus_position)) %>% {if(.){stop("locus number are consistent");}}
  not_varied_loci %>% {which(. == "varied")} %>% {length(.) != length(locus_position)} %>%
    {if(.){stop("locus_position doesn't match with not_varied_loci");}}
  # get info, remove locus_position-----------------------------------------------------------------
  info <- phased_loci %>% {list(name=rownames(.), locus_position=locus_position, haplo_freq=integer(),
                                n_indiv=nrow(.), n_locus=ncol(.), n_haplo=0L)}
  remove(locus_position)
  # convert phased_loci from loci into 2 matrices--------------------------------------------------------------
  if("" == "method 1, use pegas::haplotype()"){
    # phased_loci %>% {pegas::haplotype(x=., locus=1:ncol(.), compress=TRUE)}
    ans <- {1:nrow(phased_loci)} %>% {. * 2} %>% {list(. - 1, .)}
    phased_loci %<>% {pegas::haplotype(x=., locus=1:ncol(.), compress=FALSE)} %>% base::t(x=.) %>%
      {mapply(FUN=function(xx, ii){xx[ii,]}, xx=list(.), ii=ans, SIMPLIFY=FALSE, USE.NAMES=FALSE)} %>%
      lapply(FUN=base::`rownames<-`, value=rownames(phased_loci))
    remove(ans)
  }
  if("" != "method 2, use pegas::loci2alleles()"){
    ans <- {1:ncol(phased_loci)} %>% {. * 2} %>% {list(. - 1, .)}
    phased_loci %<>% loci2alleles() %>%
      {base::`colnames<-`(x=., value=base::sub(pattern="\\.(1|2)$", replacement="", x=colnames(.)))} %>%
      {mapply(FUN=function(xx, ii){xx[,ii]}, xx=list(.), ii=ans, SIMPLIFY=FALSE, USE.NAMES=FALSE)}
    remove(ans)
  }
  # split phased_loci into haplo and info_indiv, get info$haplo_freq, info$n_haplo------------------------
  phased_loci %<>% lapply(FUN=base::`colnames<-`, value=NULL) %>% lapply(FUN=purrr::array_tree, margin=1)
  #
  haplo <- phased_loci %>% lapply(FUN=base::unname) %>% {c(.[[1]], .[[2]])} %>%
    {list(all=., unique=base::unique(.))} # create haplo in list format
  haplo <- base::match(x=haplo$all, table=haplo$unique) %>% base::table() %>%
    as.character() %>% setNames(object=haplo$unique, nm=.) %>% simplify2array() %>%
    base::t(x=.) # get haplo occurrence times, change haplo from list into matrix
  str_rank <- function(xx){
    base::unique(xx) %>% stringr::str_sort(x=., numeric=TRUE) %>% base::match(x=xx, table=.)
  }
  haplo %<>% apply(X=., MARGIN=2, FUN=str_rank) %>% purrr::array_tree(array=., margin=2) %>%
    c(list(-as.integer(rownames(haplo))), .) %>% base::do.call(what=base::order, args=.) %>%
    haplo[.,] # sort haplo according to frequency and alphanumeric order
  remove(str_rank)
  info$haplo_freq <- rownames(haplo) %>% as.integer()
  info$n_haplo <- length(info$haplo_freq)
  #
  info_indiv <- tibble(name=info$name, genotype="",
                       haplotype_1=base::match(x=phased_loci[[1]], table=purrr::array_tree(array=haplo, margin=1)),
                       haplotype_2=base::match(x=phased_loci[[2]], table=array_tree(array=haplo, margin=1)))
  info_indiv[info_indiv$haplotype_1 > info_indiv$haplotype_2,3:4] %<>% base::rev(x=.)
  #
  haplo %<>% {base::`rownames<-`(x=., value=paste0("hap", 1:nrow(.)));}
  info_indiv$haplotype_1 %<>% {rownames(haplo)[.]}
  info_indiv$haplotype_2 %<>% {rownames(haplo)[.]}
  info_indiv %<>% dplyr::mutate(genotype=paste0(haplotype_1, "/", haplotype_2))
  #
  remove(phased_loci)
  # create output_directory-------------------------------------------------------------------------
  output_directory <- base::tempfile() %>% base::normalizePath(winslash="/", mustWork=FALSE)
  base::dir.create(path=output_directory, recursive=FALSE)
  dir.exists(paths=output_directory) %>% {if(!.){stop("can't create directory: ", output_directory);}}
  if(!grepl(pattern="/$", x=output_directory)){output_directory <- paste0(output_directory, "/");}
  # prepare an array for .xml-----------------------------------------------------------------------
  rare_haplo <- c("position", "residue", "residue_frequency", "other_residue_frequencies",
    "excised_frequency") %>% list(five_items=., locus=NULL, haplotype=rownames(haplo)) %>%
    array(data="", dim=c(5L, info$n_locus, info$n_haplo), dimnames=.)
  rare_haplo[1,,] <- info$locus_position %>% as.character() %>% list() %>% rep(times=info$n_haplo) %>% simplify2array()
  rare_haplo[2,,] <- base::t(haplo)
  #
  f_frequency <- function(xx, weight){
    # xx <- sample(letters[1:6], size=20, replace=TRUE)
    # weight <- sample(1:6, size=20, replace=TRUE)
    if(!is.character(xx) | length(xx) == 0){stop("invalid input");}
    if(!is.integer(weight) | length(weight) != length(xx)){stop("invalid input");}
    if(any(weight < 1)){stop("invalid input");}
    xx <- questionr::wtd.table(x=xx, weights=weight, digits=10) %>% # wtd.table() will sort in lexical order
      {setNames(object=as.integer(.), nm=names(.));}
    ans <- rep("0", times=length(xx))
    if(length(xx) > 1) for(i in 1:length(xx)){
      ans[i] <- xx[-i] %>% {paste0(unname(.), names(.), collapse=",");}
    }else{
      # Do nothing. Only happen when there's only 1 locus.
    }; i <- 0; remove(i);
    xx <- list(xx, setNames(object=ans, nm=names(xx)))
    return(xx) # remove(xx, weight, ans)
  }
  haplo_minus <- haplo %>% lapply(X=1:ncol(haplo), FUN=function(ii, xx){
    # apply(X=xx[,-ii], MARGIN=1, FUN=paste0, collapse="")
    xx <- purrr::array_tree(array=xx[,-ii], margin=1)
    xx <- base::match(x=xx, table=base::unique(xx))
    xx <- paste0("_", xx)
    return(xx)
  }, xx=.) %>% simplify2array()
  rare_haplo[3,,] <- haplo %>% apply(X=., MARGIN=2, FUN=f_frequency, weight=info$haplo_freq) %>%
    lapply(FUN=function(xx){xx[[1]]}) %>%
    mapply(FUN=function(xx, ii){unname(xx[ii]);}, xx=., ii=purrr::array_tree(array=haplo, margin=2),
           SIMPLIFY=TRUE, USE.NAMES=FALSE) %>% base::t(x=.)
  rare_haplo[4,,] <- haplo %>% apply(X=., MARGIN=2, FUN=f_frequency, weight=info$haplo_freq) %>%
    lapply(FUN=function(xx){xx[[2]]}) %>%
    mapply(FUN=function(xx, ii){unname(xx[ii]);}, xx=., ii=purrr::array_tree(array=haplo, margin=2),
           SIMPLIFY=TRUE, USE.NAMES=FALSE) %>% base::t(x=.)
  rare_haplo[5,,] <- haplo_minus %>% apply(X=., MARGIN=2, FUN=f_frequency, weight=info$haplo_freq) %>%
    lapply(FUN=function(xx){xx[[1]]}) %>%
    mapply(FUN=function(xx, ii){unname(xx[ii]);}, xx=., ii=purrr::array_tree(array=haplo_minus, margin=2),
           SIMPLIFY=TRUE, USE.NAMES=FALSE) %>% base::t(x=.)
  remove(f_frequency, haplo_minus)
  # get info_geno, modify info_indiv$genotype, get info_haplo------------------------------------------
  info_geno <- info_indiv %>% {base::split(x=.$name, f=.$genotype)} %>%
    {tibble(name=names(.), haplotype_1="", haplotype_2="", freq=lengths(.),
            occurrence_in_individual=lapply(X=unname(.), FUN=stringr::str_sort, numeric=TRUE))}
  ans <- info_geno$name %>% base::strsplit(split="/") %>% simplify2array()
  info_geno$haplotype_1 <- ans[1,]
  info_geno$haplotype_2 <- ans[2,]
  remove(ans)
  info_geno %<>% .[c("haplotype_1", "haplotype_2")] %>%
    lapply(FUN=function(xx){base::match(x=xx, table=stringr::str_sort(x=unique(xx), numeric=TRUE));}) %>%
    {base::order(.[[1]], .[[2]])} %>% info_geno[.,] %>% dplyr::mutate(name=paste0("gen", 1:length(name)))
  #
  # if the haplotype names contain "/", there may be bugs.
  info_indiv$genotype <- info_geno %>% {paste0(.$haplotype_1, "/", .$haplotype_2)} %>%
    setNames(object=info_geno$name, nm=.) %>% .[info_indiv$genotype] %>% unname()
  #
  min_r <- rare_haplo[3,,] %>% apply(MARGIN=2, FUN=as.integer) %>% apply(MARGIN=2, base::min) %>% unname()
  max_e <- rare_haplo[5,,] %>% apply(MARGIN=2, FUN=as.integer) %>% apply(MARGIN=2, base::max) %>% unname()
  occurrence_in_i <- info_indiv %>% {base::split(x=c(.$name, .$name), f=c(.$haplotype_1, .$haplotype_2))} %>%
    {.[stringr::str_order(x=names(.), numeric=TRUE)]} %>% lapply(FUN=base::unique) %>%
    lapply(FUN=stringr::str_sort, numeric=TRUE)
  occurrence_in_g <- info_geno %>% {base::split(x=c(.$name, .$name), f=c(.$haplotype_1, .$haplotype_2))} %>%
    {.[stringr::str_order(x=names(.), numeric=TRUE)]} %>% lapply(FUN=base::unique) %>%
    lapply(FUN=stringr::str_sort, numeric=TRUE)
  info_haplo <- occurrence_in_i %>% {base::replace(x=., list=lengths(.) > 6L, values=list("..."))} %>%
    lapply(FUN=paste0, collapse=", ") %>% unlist() %>% unname() %>%
    tibble(name=rownames(haplo), freq=info$haplo_freq, occurrence_in_individual=occurrence_in_i,
           occurrence_in_genotype=occurrence_in_g, min_residue_freq=min_r, max_excised_freq=max_e, file=.) %>%
    dplyr::mutate(file=paste0(freq, " ", min_residue_freq, " ", max_excised_freq, "; ", name, "; ", file, ";.xml")) %>%
    dplyr::mutate(file=paste0(output_directory, file))
  remove(min_r, max_e, occurrence_in_i, occurrence_in_g)
  # fill not_varied_loci in the array---------------------------------------------------------------
  dahlia <- array(data="", dim=c(5, length(not_varied_loci), info$n_haplo), dimnames=dimnames(rare_haplo))
  dahlia[2,,] <- not_varied_loci %>%
    purrr::map_if(.x=., .p=(. != "varied"), .f=stringr::str_trunc, width=15, side="center") %>%
    unlist() %>% list() %>% rep(times=info$n_haplo) %>% simplify2array()
  dahlia[,not_varied_loci == "varied",] <- rare_haplo
  rare_haplo <- dahlia
  remove(dahlia)
  # prepare the array for pretty print--------------------------------------------------------------
  # rare_haplo %>% apply(MARGIN=c(2, 3), FUN=function(xx){
  #   stringr::str_pad(string=xx, width=max(nchar(xx)) + 2, side="both")
  # }) %>% {base::`dimnames<-`(x=., value=base::replace(x=dimnames(rare_haplo), list=1L, values=dimnames(rare_haplo)[1]))}
  for(i in 1:length(not_varied_loci)) for(j in 1:info$n_haplo){
    rare_haplo[,i,j] %<>% {stringr::str_pad(string=., width=max(nchar(.)) + 2, side="both")}
  }; remove(i, j);
  dimnames(rare_haplo)[[1]] %<>% stringr::str_pad(string=., width=max(nchar(.)) + 2, side="right") %>% paste0(., ": ")
  # export and remove the array---------------------------------------------------------------------
  for(i in 1:nrow(info_haplo)){
    cat("<root>\n",
        "<!--file name's meaning: haplotype_frequency minimum_residue_frequency maximum_excised_frequency; ",
        "haplotype_name; occurrence_in_individuals_or_..._if_too_many;.xml-->\n",
        "<haplotype_name>", info_haplo$name[i], "</haplotype_name>\n",
        "<haplotype_frequency>", info_haplo$freq[i], "</haplotype_frequency>\n",
        "<occurrence_in_individual>", paste0(info_haplo$occurrence_in_individual[[i]], collapse=", "), "</occurrence_in_individual>\n",
        "<minimum_residue_frequency>", info_haplo$min_residue_freq[i], "</minimum_residue_frequency>\n",
        "<maximum_excised_frequency>", info_haplo$max_excised_freq[i], "</maximum_excised_frequency>\n",
        "<array>\n", file=info_haplo$file[i], append=FALSE, sep="")
    write.table(x=rare_haplo[,,i], file=info_haplo$file[i], append=TRUE, quote=FALSE,
                sep="", row.names=TRUE, col.names=FALSE)
    cat("</array>\n", "</root>\n", file=info_haplo$file[i], append=TRUE, sep="")
  }; remove(i);
  remove(rare_haplo)
  # export haplo, haplo_full, info_haplo, info_geno, info_indiv, etc to info.xml---------------------------
  haplo_full <- not_varied_loci %>% list() %>% rep(times=info$n_haplo) %>% simplify2array() %>%
    base::t(x=.) %>% base::`rownames<-`(x=., value=rownames(haplo))
  haplo_full[,not_varied_loci == "varied"] <- haplo
  info_haplo %<>% dplyr::select(name, freq, occurrence_in_individual, occurrence_in_genotype) %>%
    dplyr::mutate(occurrence_in_individual=lapply(X=occurrence_in_individual, FUN=paste0, collapse=", "),
                  occurrence_in_genotype=lapply(X=occurrence_in_genotype, FUN=paste0, collapse=", ")) %>%
    dplyr::mutate(occurrence_in_individual=unname(unlist(occurrence_in_individual)),
                  occurrence_in_genotype=unname(unlist(occurrence_in_genotype)))
  info_geno %<>% dplyr::mutate(occurrence_in_individual=lapply(X=occurrence_in_individual, FUN=paste0, collapse=", ")) %>%
    dplyr::mutate(occurrence_in_individual=unname(unlist(occurrence_in_individual)))
  file_ans <- paste0(output_directory, "info.xml")
  cat("<root>\n",
      "<n_individual>", info$n_indiv, "</n_individual>\n",
      "<n_genotype>", nrow(info_geno), "</n_genotype>\n",
      "<n_haplotype>", info$n_haplo, "</n_haplotype>\n",
      "<locus_position>", paste0(info$locus_position, collapse=" "), "</locus_position>\n",
      "<haplotype>\n", file=file_ans, append=FALSE, sep="")
  write.table(x=haplo, file=file_ans, append=TRUE, sep="\t", row.names=TRUE, col.names=FALSE, fileEncoding="UTF-8")
  cat("</haplotype>\n", "<haplotype_full>\n", file=file_ans, append=TRUE, sep="")
  write.table(x=haplo_full, file=file_ans, append=TRUE, sep="\t", row.names=TRUE, col.names=FALSE, fileEncoding="UTF-8")
  cat("</haplotype_full>\n", "<info_individual>\n", file=file_ans, append=TRUE, sep="")
  suppressWarnings(expr={
    write.table(x=info_indiv, file=file_ans, append=TRUE, sep="\t", row.names=FALSE, col.names=TRUE, fileEncoding="UTF-8")
  })
  cat("</info_individual>\n", "<info_genotype>\n", file=file_ans, append=TRUE, sep="")
  suppressWarnings(expr={
    write.table(x=info_geno, file=file_ans, append=TRUE, sep="\t", row.names=FALSE, col.names=TRUE, fileEncoding="UTF-8")
  })
  cat("</info_genotype>\n", "<info_haplotype>\n", file=file_ans, append=TRUE, sep="")
  suppressWarnings(expr={
    write.table(x=info_haplo, file=file_ans, append=TRUE, sep="\t", row.names=FALSE, col.names=TRUE, fileEncoding="UTF-8")
  })
  cat("</info_haplotype>\n", "</root>\n", file=file_ans, append=TRUE, sep="")
  remove(file_ans)
  # calculate hash value of output_directory--------------------------------------------------------
  # file_name <- list.files(path=output_directory, full.names=TRUE, no..=TRUE)
  # file_sha1 <- vector(mode="character", length=length(file_name))
  # for(i in 1:length(file_name)){
  #   file_con <- base::file(description=file_name[i], open="rb")
  #   file_sha1[i] <- as.character(openssl::sha1(x=file_con))
  #   base::close(con=file_con)
  #   remove(file_con)
  # }; remove(i);
  old_files <- output_directory %>% list.files(path=., full.names=TRUE, no..=TRUE)
  output_directory <- old_files %>% stringr::str_sort(numeric=TRUE) %>%
    lapply(FUN=digest::digest, algo="crc32", serialize=FALSE, file=TRUE) %>%
    unlist() %>% paste0(collapse="") %>% digest::digest(algo="crc32", serialize=TRUE) %>%
    paste0("./", info$n_haplo, "_", ., strftime(x=Sys.time(), format="_%H%M%S/")) %>%
    base::normalizePath(winslash="/", mustWork=FALSE)
  dir.create(path=output_directory, recursive=FALSE)
  if(!dir.exists(output_directory)){stop("can't create directory: ", output_directory);}
  file.copy(from=old_files, to=output_directory, overwrite=TRUE) %>%
    {if(!all(.)){stop("error when coping files to new directory");}} # try file.rename() in revision
  remove(old_files)
  # clean environment and return output_directory---------------------------------------------------
  remove(not_varied_loci, haplo, haplo_full, info, info_indiv, info_geno, info_haplo)
  message("\nresults are written to this directory:\n", output_directory, "\n")
  return(output_directory)
}


#--------------------------------------------------------------------------#
# This function will create a list of csv files that contain the isolates in
# rows and loci in columns. This currently only works for unlabeled files,
# but what it will do is allow the user to specify an entire directory to
# analyze.
#
# It will change in the future, but it works for my purposes for now.
#--------------------------------------------------------------------------#
getfile <- function(multFile=NULL, pattern=NULL){
# the default option is to grab all of the files in a directory matching a
# specified pattern. If no pattern is set, all files will be listed.
	if (is.null(multFile) || multFile == "yes"){
		# this sets the path variable that the user can use to set the path
		# to the files with setwd(x$path), where x is the datastructure
		# this function dumped into.
		path <- sub("(^.+?/).+?\\.[a-z]{3}", "\\1", file.path(file.choose()))
		if (!is.null(pattern)){
			pat <- pattern
			x <- list.files(path, pattern=pat)
		}
		else {
			x <- list.files(path)
		}
	}
	else {
		# if the user chooses to analyze only one file, a pattern is not needed
		csv <- file.choose()
		path <- sub("(^.+?/).+?\\.[a-z]{3}", "\\1", file.path(csv))
		csv <- sub("^.+?/(.+?\\.[a-z]{3})", "\\1", csv)
		x <- csv
	}
	filepath <- list(files=x, path=path)
	return(filepath)
}

#--------------------------------------------------------------------------#
# Here is the function that will produce the descrete distance matrix for
# diploid organisms.
# pop.matrix is a matrix of rows of individuals with columns of Loci.
# Currently the loci are every two columns in the matrix.
# Specifically, this compares two individuals at one locus. A loop for each
# type of distance matrix will need to be constructued separately
#
# i is the row for each new individual in the pairwise comparison
# j is the row for the reference individual
# m is the column for the first allele in the locus
# n is the column for the second allele in the locus
# z is the measure of distance. It should be zero before the loop
#
# Again, this is for diploids. position of the allele at the locus does not
# matter as the inheritance is unknown, so this algorithm takes that into
# account when doing the calculations.
#--------------------------------------------------------------------------#
difference.test <- function(pop.matrix, i, j, m, n, z){
	# This if loop is analyzing allele m of individual j against that of
	# individual i. If they are equal, then that means the distance is equal
	# to zero at that allele.
	if(pop.matrix[j,m] == pop.matrix[i,m]){
		# given that the distance between allele m in individuals j and i
		# are equal, there is only one more comparison to do. If allele n
		# of individual j is equal to that of individual i, then the
		# distance is equal to 0. If they are not equal, z at the locus is 1
		if(pop.matrix[j,n] != pop.matrix[i,n]){
			z <- z+1
		}
	}
	# If allele m of individual j is not equal to that of individual i, then
	# a test to see if allele m is equal to allele n in individuals j and i,
	# respectively.
	else if(pop.matrix[j,m] == pop.matrix[i,n]){
		# given that the distance between alleles m and n in individuals j
		# and i respectively are equal, the only comparison left is to
		# compare the distances between alleles m and n in individuals i and
		# j respectively. If they are not equal, z at the locus is 1
		if(pop.matrix[j,n] != pop.matrix[i,m]){
			z <- z+1
		}
	}
	# If neither allele in individual i is equal to allele m in individual j
	# z is equal to one and a tests if the n allele of individual j is equal
	# to either allele in individual i.
	else{
		z <- z+1
		# Testing if the n allele in individual j is not equal to either allele
		# in individual i. If neither is equal, z at the locus increases by 1.
		if(pop.matrix[j,n] != pop.matrix[i,m] && pop.matrix[j,n] != pop.matrix[i,n]){
			z <- z+1
		}
	}
	# The final value of z is returned. At this point it can take on the
	# values of 0, 1, or 2 if doing a pairwise comparison at a single locus.
	# For pairwise comparisons over multiple loci, z can take on any value
	# between 0 and 2*M where M is the number of loci sampled.
	return(z)
}

stdIa <- function(x){
	#--------------------------------------------------------------------------#
	# This is the beginning of the analysis. It will take the list of files
	# provided by the user and pull the files out of the directory that has
	# been set by the user.
	#--------------------------------------------------------------------------#
	for(a in 1:length(x)){
		pop <- read.table(file(description= x[a], open="r"))
		pop.matrix <- as.matrix(pop)
		numAlleles <- ncol(pop.matrix)
		numIsolates <- nrow(pop.matrix)
		np <- (numIsolates*(numIsolates-1))/2
		# Creation of the datastructures
		if (!exists("Ia.vector")){
			Ia.vector <- NULL
			rbarD.vector <- NULL
			file.vector <- NULL
		}
		D.matrix <- matrix(0, nrow=numIsolates, ncol=numIsolates)
		d.matrix <- D.matrix
		d.vector <- NULL
		d2.vector <- NULL
		vard.vector <- NULL
		vardpair.vector <- NULL
		to.remove <- NULL
	#--------------------------------------------------------------------------#
	# This is the loop for analyzing the pairwise distances at each locus,
	# also known as d. These values will be placed into two vectors representing
	# the sum of d for each locus and the sum of d^2 for each locus.
	#
	# This will also calculate D, the pairwise comparison of all isolates over
	# all loci.
	#--------------------------------------------------------------------------#
		# Initiating the loop over the columns of the population matrix
		for(m in seq(1, (numAlleles-1), 2)){
			n <- m+1
			# Loop for the columns of the distance matrix
			for(j in 1:numIsolates){
				# Loop for the rows of the distance matrix
				for(i in 1:numIsolates){
					z <- 0
					# Setting the contraint for the pairwise comparisons by the
					# equation (n(n-1))/2 where n = numIsolates
					# If this loop did not exist, the construction of the
					# distance matrix would take twice as long.
					if(j < i && i <= numIsolates){
						z <- difference.test(pop.matrix, i, j, m, n, z)
					}
					# The value of z (0, 1, or 2) is pushed into the matrix
					d.matrix[i,j] <- d.matrix[i,j]+z
					# This value is added to the matrix for pairwise comparison
					# of all the isolates over all loci as opposed to each locus
					D.matrix[i,j] <- D.matrix[i,j]+d.matrix[i,j]
				}
			}
			# placing the sum of the resulting matrix into a vector for later
			# use
			d.vector <- append(d.vector, sum(d.matrix))
			# placing the sum of the squares of the resulting matrix into a
			# vector for later use
			d2.vector <- append(d2.vector, sum(d.matrix^2))
			# zeroing out the matrix
			d.matrix[1:numIsolates,1:numIsolates] <- 0
		}
		# removing the matrix from the namespace as it is no longer needed.
		rm(d.matrix)
	#--------------------------------------------------------------------------#
	# Now to begin the calculations. First, set the variance of D
	#--------------------------------------------------------------------------#
		varD <- ((sum(D.matrix^2)-((sum(D.matrix))^2)/np))/np
	#--------------------------------------------------------------------------#
	# Next is to create a vector containing all of the variances of d (there
	# will be one for each locus)
	#--------------------------------------------------------------------------#
		vard.vector <- ((d2.vector-((d.vector^2)/np))/np)
	#--------------------------------------------------------------------------#
	# Here the roots of the products of the variances are being produced and
	# the sum of those values is taken.
	#--------------------------------------------------------------------------#
		for (b in 1:length(d.vector)){
			for (d in 1:length(d.vector)){
				# As pairwise multiplication is required, a pairwise constriant
				# loop must be set up.
				if(b < d && d <= length(d.vector)){
					vardpair <- sqrt(vard.vector[b]*vard.vector[d])
					vardpair.vector <- append(vardpair.vector, vardpair)
				}
			}
		}
	#--------------------------------------------------------------------------#
	# The sum of the variances necessary for the calculation of Ia is calculated
	#--------------------------------------------------------------------------#
		sigVarj <- sum(vard.vector)
		rm(vard.vector)
	#--------------------------------------------------------------------------#
	# Finally, the Index of Association and the standardized Index of associati-
	# on are calculated.
	#--------------------------------------------------------------------------#
		Ia <- (varD/sigVarj)-1
		rbarD <- (varD - sigVarj)/(2*sum(vardpair.vector))
		# Prints to screen as loop progresses
		print(paste("File Name:", x[a], sep=" "))
		print(paste("Index of Association:", Ia, sep=" "))
		print(paste("Standardized Index of Association (rbarD):", rbarD, sep=" "))
		# Saves the values of Ia, rbarD, and the filename into datastructures
		# that will be listed in a dataframe
		file.vector <- append(file.vector, x[a])
		Ia.vector <- append(Ia.vector, Ia)
		rbarD.vector <- append(rbarD.vector, rbarD)
	}
	# Creating the data frame for output.
	Iout <- list(Ia=Ia.vector, rbarD=rbarD.vector, File=file.vector)
	return(as.data.frame(Iout))
}


# Day 16: Packet Decoder

get_day16_input_path <- function() {
    paste(getwd(), "/2021/Day 16/Day16_input.txt", sep = "")
}

packets <- matrix(ncol = 5)[-1, ]
packet_depth <- 0

part1 <- function() {
    readings <- readLines(get_day16_input_path())
    chars <- unlist(strsplit(readings[1], ""))

    binary <- R.utils::intToBin(strtoi(chars, base = 16L))
    binary_str <- paste(binary, collapse = "")
    bits <- unlist(strsplit(binary_str, ""))

    main_packet <- create_packet(bits)

    if (main_packet[2] == 4) {
        # Calculate literal value
        main_packet <- set_literal_value(bits, 7, main_packet)
        packets <<- rbind(packets, c(main_packet))
    } else {
        # Process operator
        packets <<- rbind(packets, c(main_packet))
        process_packets(bits, 7)
    }

    print(packets)
    cat("Sum of versions:", sum(packets[, 1]), "\n")
    cat("Sum of values:", sum(packets[, 3]), "\n")
}

part2 <- function() {
    print("TODO")
}

create_packet <- function(bits) {
    version <- bits[1:3]
    version_dec <- strtoi(paste(version, collapse = ""), base = 2)

    type <- bits[4:6]
    type_dec <- strtoi(paste(type, collapse = ""), base = 2)

    # version, type, value, next_index
    packet <- c(version_dec, type_dec, 0, 0, packet_depth)
    packet
}

# Process Packets assumes it's being passed an Operator packet
# Start Index is the index of the length indicator
process_packets <- function(bits, start_index) {
    packet_depth <<- packet_depth + 1
    cat("Entering packet depth:", packet_depth, "\n")
    length_ind <- bits[start_index]
    next_packet_index <- 0

    if (length_ind == "0") {
        print("15-bit Operator")
        # 15-bit length mode, parse length of all subpackets
        subpackets_len <- bits[(start_index + 1):(start_index + 15)]
        sp_len_dec <- strtoi(paste(subpackets_len, collapse = ""), base = 2)
        cat(sp_len_dec, "bits to process\n")

        sp_bound <- start_index + 15 + sp_len_dec

        # Next packet index will pass up to previous caller
        # 15-bit mode makes this easy since it tells us where the packet ends
        next_packet_index <- sp_bound + 1
        sp_bits_start <- start_index + 15 + 1

        sp_bits <- bits[sp_bits_start:sp_bound]
        sp_bits <- sp_bits[!is.na(sp_bits)]

        end_of_bits <- FALSE
        bits_processed <- 0

        # Process packets while we have bits left to consume
        while (!end_of_bits) {
            packet <- create_packet(sp_bits)
            if (packet[2] == 4) {
                # Packet is a literal value
                packet <- set_literal_value(sp_bits, 7, packet)

                # Packet[4] is the index immediately after its last bit
                bits_processed <- bits_processed + packet[4] - 1
                cat("L Proc'd", bits_processed, "of", sp_len_dec, "bits\n")
                if (bits_processed == sp_len_dec) {
                    end_of_bits <- TRUE
                } else {
                    # We have more bits to go, trim the packet we just processed
                    sp_bits <- sp_bits[packet[4]:length(sp_bits)]
                    sp_bits <- sp_bits[!is.na(sp_bits)]
                }

                # Add literal value packet to list
                packets <<- rbind(packets, c(packet))
            } else {
                # This is an operator packet, add it to the list
                packets <<- rbind(packets, c(packet))

                # Recursively inspect this operator packet
                next_subpacket_index <- process_packets(sp_bits, 7)

                # Process packet returns the bounds of this packet + 1
                # (AKA the next packet starting point)
                bits_processed <- bits_processed + next_subpacket_index - 1
                cat("O Proc'd", bits_processed, "of", sp_len_dec, "bits\n")

                if (bits_processed == sp_len_dec) {
                    end_of_bits <- TRUE
                } else {
                    # We have more bits to go, trim the packet we just processed
                    new_sp_bits_start <- sp_bits_start + bits_processed
                    sp_bits <- bits[new_sp_bits_start:sp_bound]
                    sp_bits <- sp_bits[!is.na(sp_bits)]
                }
            }
        }
    } else {
        print("11-bit operator")
        # 11-bit length mode, parse number of subpackets in this packet
        num_subpackets <- bits[(start_index + 1):(start_index + 11)]
        sp_num_dec <- strtoi(paste(num_subpackets, collapse = ""), base = 2)

        cat(sp_num_dec, "subpackets to process\n")

        # Move bits cursor up to first subpacket starting index
        sp_bits <- bits[(start_index + 11 + 1):length(bits)]
        sp_bits <- sp_bits[!is.na(sp_bits)]

        # Store running calculation of the next packet index
        # Harder than 15-bit mode since the length of this packet starts unknown
        next_packet_index <- start_index + 11 + 1
        for (i in 1:sp_num_dec) {
            packet <- create_packet(sp_bits)
            if (packet[2] == 4) {
                # Packet is a literal value
                packet <- set_literal_value(sp_bits, 7, packet)

                # Packet[4] is the index immediately after its last bit
                next_packet_index <- next_packet_index + packet[4] - 1
                cat("L Proc'd", next_packet_index - 1, "of ??? bits\n")

                # Trim the packet we just processed
                sp_bits <- sp_bits[packet[4]:length(sp_bits)]
                sp_bits <- sp_bits[!is.na(sp_bits)]

                # Add literal value packet to list
                packets <<- rbind(packets, c(packet))
            } else {
                # This is an operator packet, add it to the list
                packets <<- rbind(packets, c(packet))

                # Recursively inspect this operator packet
                next_packet_index <- next_packet_index +
                                     process_packets(sp_bits, 7) - 1
                cat("O Proc'd", next_packet_index - 1, "of ??? bits\n")

                # Trim the packet we just processed
                sp_bits <- bits[next_packet_index:length(bits)]
                sp_bits <- sp_bits[!is.na(sp_bits)]
            }
        }
    }
    cat("Exiting packet depth:", packet_depth, "\n")
    packet_depth <<- packet_depth - 1
    next_packet_index
}

set_literal_value <- function(bits, start_index, packet) {
    value <- ""
    last_num <- FALSE
    next_index <- start_index
    while (!last_num) {
        num <- bits[next_index:(next_index + 4)]
        if (num[1] == "0") {
            last_num <- TRUE
        }
        value <- paste(value, paste(num[2:5], collapse = ""), sep = "")
        next_index <- next_index + 5
    }
    packet[3] <- strtoi(value, base = 2)
    packet[4] <- next_index
    packet
}

part1()
part2()


# Program to check
if the input number is prime or not
# take input from the user
num = as.integer(readline(prompt = "Enter a number: "))
flag = 0
# prime numbers are greater than 1
if (num > 1) {
  # check
  for factors
  flag = 1
  for (i in 2: (num - 1)) {
    if ((num % % i) == 0) {
      flag = 0
      break
    }
  }
}
if (num == 2) flag = 1
if (flag == 1) {
  print(paste(num, "is a prime number"))
} else {
  print(paste(num, "is not a prime number"))
}