I am trying to import a number of Fortran 90 codes into R for a project. They were initially written with a mex (matlab integration of Fortran routines) type compilation in mind. This is what one of the codes look like:
# include <fintrf.h>
subroutine mexFunction(nlhs, plhs, nrhs, prhs)
!--------------------------------------------------------------
! MEX file for VFI3FCN routine
!
! log M_{t,t+1} = log \beta + gamma (x_t - x_{t+1})
! gamma = gamA + gamB (x_t - xbar)
!
!--------------------------------------------------------------
implicit none
mwPointer plhs(*), prhs(*)
integer nlhs, nrhs
mwPointer mxGetM, mxGetPr, mxCreateDoubleMatrix
mwPointer nk, nkp, nz, nx, nh
mwSize col_hxz, col_hz, col_xz
! check for proper number of arguments.
if(nrhs .ne. 31) then
call mexErrMsgTxt('31 input variables required.')
elseif(nlhs .ne. 4) then
call mexErrMsgTxt('4 output variables required.')
endif
! get the size of the input array.
nk = mxGetM(prhs(5))
nx = mxGetM(prhs(7))
nz = mxGetM(prhs(11))
nh = mxGetM(prhs(14))
nkp = mxGetM(prhs(16))
col_hxz = nx*nz*nh
col_xz = nx*nz
col_hz = nz*nh
! create matrix for the return arguments.
plhs(1) = mxCreateDoubleMatrix(nk, col_hxz, 0)
plhs(2) = mxCreateDoubleMatrix(nk, col_hxz, 0)
plhs(3) = mxCreateDoubleMatrix(nk, col_hxz, 0)
plhs(4) = mxCreateDoubleMatrix(nk, col_hxz, 0)
call vfi3fcnIEccB(%val(mxGetPr(plhs(1))), nkp)
return
end
subroutine vfi3fcnIEccB(optK, V, I, div, & ! output variables
alp1, alp2, alp3, V0, k, nk, x, xbar, nx, Qx, z, nz, Qz, h, nh, kp, &
alpha, beta, delta, f, gamA, gamB, gP, gN, istar, kmin, kmtrx, ksubm, hmtrx, xmtrx, zmtrx, &
nkp, col_hxz, col_xz, col_hz)
use ifwin
implicit none
! specify input and output variables
integer, intent(in) :: nk, nkp, nx, nz, nh, col_hxz, col_xz, col_hz
real*8, intent(out) :: V(nk, col_hxz), optK(nk, col_hxz), I(nk, col_hxz), div(nk, col_hxz)
real*8, intent(in) :: V0(nk, col_hxz), k(nk), kp(nkp), x(nx), z(nz), Qx(nx, nx), Qz(nz, nz), h(nh)
real*8, intent(in) :: alp1, alp2, alp3, xbar, kmin, alpha, gP, gN, beta, delta, gamA, gamB, f, istar
real*8, intent(in) :: kmtrx(nk, col_hxz), ksubm(nk, col_hz), zmtrx(nk, col_hxz), xmtrx(nk, col_hxz), hmtrx(nk, col_hxz)
! specify intermediate variables
real*8 :: Res(nk, col_hxz), Obj(nk, col_hxz), optKold(nk, col_hxz), Vold(nk, col_hxz), tmpEMV(nkp, col_hz), tmpI(nkp), &
tmpObj(nkp, col_hz), tmpA(nk, col_hxz), tmpQ(nx*nh, nh), detM(nx), stoM(nx), g(nkp), tmpInd(nh, nz)
real*8 :: Qh(nh, nh, nx), Qxh(nx*nh, nx*nh), Qzxh(col_hxz, col_hxz)
real*8 :: hp, d(nh), errK, errV, T1, lapse
integer :: ix, ih, iter, optJ(col_hz), ik, iz, ind(nh, col_xz), subindex(nx, col_hz)
logical*4 :: statConsole
! construct the transition matrix for kh --- there are nx number of these transition matrix: 3-d
Qh = 0.0
do ix = 1, nx
do ih = 1, nh
! compute the predicted next period kh
hp = alp1 + alp2*h(ih) + alp3*(x(ix) - xbar)
! construct transition probability vector
d = abs(h - hp) + 1D-32
Qh(:, ih, ix) = (1/d)/sum(1/d)
end do
end do
! construct the compound transition matrix over (z x h) space
! compound the (x h) space
Qxh = 0.0
do ix = 1, nx
call kron(tmpQ, Qx(:, ix), Qh(:, :, ix), nx, 1, nh, nh)
Qxh(:, (ix - 1)*nh + 1 : ix*nh) = tmpQ
end do
! compound the (z x h) space: h changes the faster, followed by x, and z changes the slowest
call kron(Qzxh, Qz, Qxh, nz, nz, nx*nh, nx*nh)
! available funds for the firm
Res = dexp(xmtrx + zmtrx + hmtrx)*(kmtrx**alpha) + (1 - delta)*kmtrx - f
! initializing
Obj = 0.0
optK = 0.0
optKold = optK + 1.0
Vold = V0
! Some Intermediate Variables Used in Stochastic Discount Factor
detM = beta*dexp((gamA - gamB*xbar)*x + gamB*x**2)
stoM = -(gamA - gamB*xbar + gamB*x)
! Intermediate index vector to facilitate submatrix extracting
ind = reshape((/1 : col_hxz : 1/), (/nh, col_xz/))
do ix = 1, nx
tmpInd = ind(:, ix : col_xz : nx)
do iz = 1, nz
subindex(ix, (iz - 1)*nh + 1 : iz*nh) = tmpInd(:, iz)
end do
end do
! start iterations
errK = 1.0
errV = 1.0
iter = 0
T1 = secnds(0.0)
do
if (errV <= 1D-3 .AND. errK <= 1D-8) then
exit
else
iter = iter + 1
do ix = 1, nx
! next period value function by linear interpolation: nkp by nz*nh matrix
call interp1(tmpEMV, k, detM(ix)*(matmul(dexp(stoM(ix)*xmtrx)*Vold, Qzxh(:, subindex(ix, :)))) - ksubm, kp, &
nk, nkp, col_hz)
! maximize the right-hand size of Bellman equation on EACH grid point of capital stock
do ik = 1, nk
! with istar tmpI is no longer investment but a linear transformation of that
tmpI = (kp - (1.0 - delta)*k(ik))/k(ik) - istar
where (tmpI >= 0.0)
g = gP
elsewhere
g = gN
end where
tmpObj = tmpEMV - spread((g/2.0)*(tmpI**2)*k(ik), 2, col_hz)
! direct discrete maximization
Obj(ik, subindex(ix, :)) = maxval(tmpObj, 1)
optJ = maxloc(tmpObj, 1)
optK(ik, subindex(ix, :)) = kp(optJ)
end do
end do
! update value function and impose limited liability condition
V = max(Res + Obj, 1D-16)
! convergence criterion
errK = maxval(abs(optK - optKold))
errV = maxval(abs(V - Vold))
! revise Initial Guess
Vold = V
optKold = optK
! visual
if (modulo(iter, 50) == 0) then
lapse = secnds(T1)
statConsole = AllocConsole()
print "(a, f10.7, a, f10.7, a, f8.1, a)", " errV:", errV, " errK:", errK, " Time:", lapse, "s"
end if
end if
end do
! visual check on errors
lapse = secnds(T1)
statConsole = AllocConsole()
print "(a, f10.7, a, f10.7, a, f8.1, a)", " errV:", errV, " errK:", errK, " Time:", lapse, "s"
! optimal investment and dividend
I = optK - (1.0 - delta)*kmtrx
tmpA = I/kmtrx - istar
where (tmpA >= 0)
div = Res - optK - (gP/2.0)*(tmpA**2)*kmtrx
elsewhere
div = Res - optK - (gN/2.0)*(tmpA**2)*kmtrx
end where
return
end
subroutine interp1(v, x, y, u, m, n, col)
!-------------------------------------------------------------------------------------------------------
! Linear interpolation routine similar to interp1 with 'linear' as method parameter in Matlab
!
! OUTPUT:
! v - function values on non-grid points (n by col matrix)
!
! INPUT:
! x - grid (m by one vector)
! y - function defined on the grid x (m by col matrix)
! u - non-grid points on which y(x) is to be interpolated (n by one vector)
! m - length of x and y vectors
! n - length of u and v vectors
! col - number of columns of v and y matrices
!
! Four ways to pass array arguments:
! 1. Use explicit-shape arrays and pass the dimension as an argument(most efficient)
! 2. Use assumed-shape arrays and use interface to call external subroutine
! 3. Use assumed-shape arrays and make subroutine internal by using "contains"
! 4. Use assumed-shape arrays and put interface in a module then use module
!
! This subroutine is equavilent to the following matlab call
! v = interp1(x, y, u, 'linear', 'extrap') with x (m by 1), y (m by col), u (n by 1), and v (n by col)
!------------------------------------------------------------------------------------------------------
implicit none
integer :: m, n, col, i, j
real*8, intent(out) :: v(n, col)
real*8, intent(in) :: x(m), y(m, col), u(n)
real*8 :: prob
do i = 1, n
if (u(i) < x(1)) then
! extrapolation to the left
v(i, :) = y(1, :) - (y(2, :) - y(1, :)) * ((x(1) - u(i))/(x(2) - x(1)))
else if (u(i) > x(m)) then
! extrapolation to the right
v(i, :) = y(m, :) + (y(m, :) - y(m-1, :)) * ((u(i) - x(m))/(x(m) - x(m-1)))
else
! interpolation
! find the j such that x(j) <= u(i) < x(j+1)
call bisection(x, u(i), m, j)
prob = (u(i) - x(j))/(x(j+1) - x(j))
v(i, :) = y(j, :)*(1 - prob) + y(j+1, :)*prob
end if
end do
end subroutine interp1
subroutine bisection(list, element, m, k)
!--------------------------------------------------------------------------------
! find index k in list such that (list(k) <= element < list(k+1)
!--------------------------------------------------------------------------------
implicit none
integer*4 :: m, k, first, last, half
real*8 :: list(m), element
first = 1
last = m
do
if (first == (last-1)) exit
half = (first + last)/2
if ( element < list(half) ) then
! discard second half
last = half
else
! discard first half
first = half
end if
end do
k = first
end subroutine bisection
subroutine kron(K, A, B, rowA, colA, rowB, colB)
!--------------------------------------------------------------------------------
! Perform K = kron(A, B); translated directly from kron.m
!
! OUTPUT:
! K -- rowA*rowB by colA*colB matrix
!
! INPUT:
! A -- rowA by colA matrix
! B -- rowB by colB matrix
! rowA, colA, rowB, colB -- integers containing shape information
!--------------------------------------------------------------------------------
implicit none
integer, intent(in) :: rowA, colA, rowB, colB
real*8, intent(in) :: A(rowA, colA), B(rowB, colB)
real*8, intent(out) :: K(rowA*rowB, colA*colB)
integer :: t1(rowA*rowB), t2(colA*colB), i, ia(rowA*rowB), ja(colA*colB), ib(rowA*rowB), jb(colA*colB)
t1 = (/ (i, i = 0, (rowA*rowB - 1)) /)
ia = int(t1/rowB) + 1
ib = mod(t1, rowB) + 1
t2 = (/ (i, i = 0, (colA*colB - 1)) /)
ja = int(t2/colB) + 1
jb = mod(t2, colB) + 1
K = A(ia, ja)*B(ib, jb)
end subroutine kron
My initial plan was to remove the mexFunction subroutine and compile the main Fortran subroutines using the R CMD SHLIB command but then I run into the Rtools compiler not knowing where to find the ifwin library even though I have the library in my intel fortran compiler folder.
So my first question is:
1) Is there a way for me to tell rtools where to find the ifwin library and any other library I need to include? Or is there a way to include the dependency libraries in the R CMD SHLIB command so the compiler can find the necessary libraries and compile?
2) If the answer to two is no, can I some how use the compiled version from Matlab in R. I can compile the file as is in matlab using the mex Zhang_4.f90 command with no errors.
3) Is there a way of setting up an environment in Visual Studio 2015 so I can compile Fortran subroutines for use in R using the Intel compiler?
When I take out the mexFunction subroutine and try compiling the rest of the code, I get the following error:
D:\SS_Programming\Fortran>R CMD SHLIB Zhang_4.f90
c:/Rtools/mingw_64/bin/gfortran -O2 -mtune=core2 -c Zhang_4.f90 -o
Zhang_4.o
Zhang_4.f90:6.4:
use ifwin
1
Fatal Error: Can't open module file 'ifwin.mod' for reading at (1): No
such file or directory
make: *** [Zhang_4.o] Error 1
Warning message:
running command 'make -f "C:/PROGRA~1/R/R-34~1.2/etc/x64/Makeconf" -f
"C:/PROGRA~1/R/R-34~1.2/share/make/winshlib.mk"
SHLIB_LDFLAGS='$(SHLIB_FCLDFLAGS)' SHLIB_LD='$(SHLIB_FCLD)'
SHLIB="Zhang_4.dll" SHLIB_LIBADD='$(FCLIBS)' WIN=64 TCLBIN=64
OBJECTS="Zhang_4.o"' had status 2
I don't think there is any other way then rewrite the code to not use IFWIN. Unless you manage to use Intel Fortran for R (that might require recompiling the whole R distribution...). Matlab is tied to Intel Fortran, that's why the code worked there.
You have to adjust the code anyway, you cannot use it as it stands.
Just get rid of the AllocConsole() calls and the print statements. You will need to use the R routines to print to console. See https://cran.r-project.org/doc/manuals/R-exts.html#Printing-from-FORTRAN
Given a word W, I want to find all words containing the letters in W from /usr/dict/words.
For example, "bat" should return "bat" and "tab" (but not "table").
Here is one solution which involves sorting the input word and matching:
word=$1
sortedWord=`echo $word | grep -o . | sort | tr -d '\n'`
while read line
do
sortedLine=`echo $line | grep -o . | sort | tr -d '\n'`
if [ "$sortedWord" == "$sortedLine" ]
then
echo $line
fi
done < /usr/dict/words
Is there a better way? I'd prefer using basic commands (instead of perl/awk etc), but all solutions are welcome!
To clarify, I want to find all permutations of the original word. Addition or deletion of characters is not allowed.
here's an awk implementation. It finds the words with those letters in "W".
dict="/usr/share/dict/words"
word=$1
awk -vw="$word" 'BEGIN{
m=split(w,c,"")
for(p=1;p<=m;p++){ chars[c[p]]++ }
}
length($0)==length(w){
f=0;g=0
n=split($0,t,"")
for(o=1;o<=n;o++){
if (!( t[o] in chars) ){
f=1; break
}else{ st[t[o]]++ }
}
if (!f || $0==w){
for(z in st){
if ( st[z] != chars[z] ) { g=1 ;break}
}
if(!g){ print "found: "$0 }
}
delete st
}' $dict
output
$ wc -l < /usr/share/dict/words
479829
$ time ./shell.sh look
found: kolo
found: look
real 0m1.361s
user 0m1.074s
sys 0m0.015s
Update: change of algorithm, using sorting
dict="/usr/share/dict/words"
awk 'BEGIN{
w="table"
m=split(w,c,"")
b=asort(c,chars)
}
length($0)==length(w){
f=0
n=split($0,t,"")
e=asort(t,d)
for(i=1;i<=e;i++) {
if(d[i]!=chars[i]){
f=1;break
}
}
if(!f) print $0
}' $dict
output
$ time ./shell.sh #looking for table
ablet
batel
belat
blate
bleat
tabel
table
real 0m1.416s
user 0m1.343s
sys 0m0.014s
$ time ./shell.sh #looking for chairs
chairs
ischar
rachis
real 0m1.697s
user 0m1.660s
sys 0m0.014s
$ time perl perl.pl #using beamrider's Perl script
table
tabel
ablet
batel
blate
bleat
belat
real 0m2.680s
user 0m1.633s
sys 0m0.881s
$ time perl perl.pl # looking for chairs
chairs
ischar
rachis
real 0m14.044s
user 0m8.328s
sys 0m5.236s
Here's a shell solution. The best algorithm seems to be #4. It filters out all words that are of incorrect length. Then, it sums the words using a simple substitution cipher (a=1, b=2, A=27, ...). If the sums match, then it will actually do the original sort and compare.
On my system, it can churn through ~235k words looking for "bat" in just under 1/2 second.
I'm providing all of my solutions so you can see the different approaches.
Update: not shown, but I also tried putting the sum inside the first bin of the histogram approach I tried, but it was even slower than the histograms without. I thought it would function as a short circuit, but it didn't work.
Update2: I tried the awk solution and it runs in about 1/3 the time of my best shell solution or ~0.126s versus ~0.490s. The perl solution runs ~1.1s.
#!/bin/bash
word=$1
#dict=words
dict=/usr/share/dict/words
#dict=/usr/dict/words
alg1() {
sortedWord=`echo $word | grep -o . | sort | tr -d '\n'`
while read line
do
sortedLine=`echo $line | grep -o . | sort | tr -d '\n'`
if [ "$sortedWord" == "$sortedLine" ]
then
echo $line
fi
done < $dict
}
check_sorted_versus_not() {
local word=$1
local line=`echo $2 | grep -o . | sort | tr -d '\n'`
if [ "$word" == "$line" ]
then
echo $2
fi
}
# Filter out all words of incorrect length
alg2() {
sortedWord=`echo $word | grep -o . | sort | tr -d '\n'`
grep_string="^`echo -n $word | tr 'a-zA-Z' '.'`\$"
grep "$grep_string" "$dict" | \
while read line
do
sortedLine=`echo $line | grep -o . | sort | tr -d '\n'`
if [ "$sortedWord" == "$sortedLine" ]
then
echo $line
fi
done
}
# Create a lot of variables like this:
# _a=1, _b=2, ... _z=26, _A=27, _B=28, ... _Z=52
gen_chars() {
# [ -n "$GEN_CHARS" ] && return
GEN_CHARS=1
local alpha="abcdefghijklmnopqrstuvwxyz"
local upperalpha=`echo -n $alpha | tr 'a-z' 'A-Z'`
local both="$alpha$upperalpha"
for ((i=0; i < ${#both}; i++))
do
ACHAR=${both:i:1}
eval "_$ACHAR=$((i+1))"
done
}
# I think it's faster to return the value in a var then to echo it in a sub process.
# Try summing the word one char at a time by building an arithmetic expression
# and then evaluate that expression.
# Requires: gen_chars
sum_word() {
SUM=0
local s=""
# parsing input one character at a time
for ((i=0; i < ${#1}; i++))
do
ACHAR=${1:i:1}
s="$s\$_$ACHAR+"
done
SUM=$(( $(eval echo -n ${s}0) ))
}
# I think it's faster to return the value in a var then to echo it in a sub process.
# Try summing the word one char at a time using a case statement.
sum_word2() {
SUM=0
local s=""
# parsing input one character at a time
for ((i=0; i < ${#1}; i++))
do
ACHAR=${1:i:1}
case $ACHAR in
a) SUM=$((SUM+ 1));;
b) SUM=$((SUM+ 2));;
c) SUM=$((SUM+ 3));;
d) SUM=$((SUM+ 4));;
e) SUM=$((SUM+ 5));;
f) SUM=$((SUM+ 6));;
g) SUM=$((SUM+ 7));;
h) SUM=$((SUM+ 8));;
i) SUM=$((SUM+ 9));;
j) SUM=$((SUM+ 10));;
k) SUM=$((SUM+ 11));;
l) SUM=$((SUM+ 12));;
m) SUM=$((SUM+ 13));;
n) SUM=$((SUM+ 14));;
o) SUM=$((SUM+ 15));;
p) SUM=$((SUM+ 16));;
q) SUM=$((SUM+ 17));;
r) SUM=$((SUM+ 18));;
s) SUM=$((SUM+ 19));;
t) SUM=$((SUM+ 20));;
u) SUM=$((SUM+ 21));;
v) SUM=$((SUM+ 22));;
w) SUM=$((SUM+ 23));;
x) SUM=$((SUM+ 24));;
y) SUM=$((SUM+ 25));;
z) SUM=$((SUM+ 26));;
A) SUM=$((SUM+ 27));;
B) SUM=$((SUM+ 28));;
C) SUM=$((SUM+ 29));;
D) SUM=$((SUM+ 30));;
E) SUM=$((SUM+ 31));;
F) SUM=$((SUM+ 32));;
G) SUM=$((SUM+ 33));;
H) SUM=$((SUM+ 34));;
I) SUM=$((SUM+ 35));;
J) SUM=$((SUM+ 36));;
K) SUM=$((SUM+ 37));;
L) SUM=$((SUM+ 38));;
M) SUM=$((SUM+ 39));;
N) SUM=$((SUM+ 40));;
O) SUM=$((SUM+ 41));;
P) SUM=$((SUM+ 42));;
Q) SUM=$((SUM+ 43));;
R) SUM=$((SUM+ 44));;
S) SUM=$((SUM+ 45));;
T) SUM=$((SUM+ 46));;
U) SUM=$((SUM+ 47));;
V) SUM=$((SUM+ 48));;
W) SUM=$((SUM+ 49));;
X) SUM=$((SUM+ 50));;
Y) SUM=$((SUM+ 51));;
Z) SUM=$((SUM+ 52));;
*) SUM=0; return;;
esac
done
}
# I think it's faster to return the value in a var then to echo it in a sub process.
# Try summing the word by building an arithmetic expression using sed and then evaluating
# the expression.
# Requires: gen_chars
sum_word3() {
SUM=$(( $(eval echo -n `echo -n $1 | sed -E -ne 's,.,$_&+,pg'`) 0))
#echo "SUM($1)=$SUM"
}
# Filter out all words of incorrect length
# Sum the characters in the word: i.e. a=1, b=2, ... and "abbc" = 1+2+2+3 = 8
alg3() {
gen_chars
sortedWord=`echo $word | grep -o . | sort | tr -d '\n'`
sum_word $word
word_sum=$SUM
grep_string="^`echo -n $word | tr 'a-zA-Z' '.'`\$"
grep "$grep_string" "$dict" | \
while read line
do
sum_word $line
line_sum=$SUM
if [ $word_sum == $line_sum ]
then
check_sorted_versus_not $sortedWord $line
fi
done
}
# Filter out all words of incorrect length
# Sum the characters in the word: i.e. a=1, b=2, ... and "abbc" = 1+2+2+3 = 8
# Use sum_word2
alg4() {
sortedWord=`echo $word | grep -o . | sort | tr -d '\n'`
sum_word2 $word
word_sum=$SUM
grep_string="^`echo -n $word | tr 'a-zA-Z' '.'`\$"
grep "$grep_string" "$dict" | \
while read line
do
sum_word2 $line
line_sum=$SUM
if [ $word_sum == $line_sum ]
then
check_sorted_versus_not $sortedWord $line
fi
done
}
# Filter out all words of incorrect length
# Sum the characters in the word: i.e. a=1, b=2, ... and "abbc" = 1+2+2+3 = 8
# Use sum_word3
alg5() {
gen_chars
sortedWord=`echo $word | grep -o . | sort | tr -d '\n'`
sum_word3 $word
word_sum=$SUM
grep_string="^`echo -n $word | tr 'a-zA-Z' '.'`\$"
grep "$grep_string" "$dict" | \
while read line
do
sum_word3 $line
line_sum=$SUM
if [ $word_sum == $line_sum ]
then
check_sorted_versus_not $sortedWord $line
fi
done
}
# I think it's faster to return the value in a var then to echo it in a sub process.
# Try summing the word one char at a time using a case statement.
# Place results in a histogram
sum_word4() {
SUM=(0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0
0)
# parsing input one character at a time
for ((i=0; i < ${#1}; i++))
do
ACHAR=${1:i:1}
case $ACHAR in
a) SUM[1]=$((SUM[ 1] + 1));;
b) SUM[2]=$((SUM[ 2] + 1));;
c) SUM[3]=$((SUM[ 3] + 1));;
d) SUM[4]=$((SUM[ 4] + 1));;
e) SUM[5]=$((SUM[ 5] + 1));;
f) SUM[6]=$((SUM[ 6] + 1));;
g) SUM[7]=$((SUM[ 7] + 1));;
h) SUM[8]=$((SUM[ 8] + 1));;
i) SUM[9]=$((SUM[ 9] + 1));;
j) SUM[10]=$((SUM[10] + 1));;
k) SUM[11]=$((SUM[11] + 1));;
l) SUM[12]=$((SUM[12] + 1));;
m) SUM[13]=$((SUM[13] + 1));;
n) SUM[14]=$((SUM[14] + 1));;
o) SUM[15]=$((SUM[15] + 1));;
p) SUM[16]=$((SUM[16] + 1));;
q) SUM[17]=$((SUM[17] + 1));;
r) SUM[18]=$((SUM[18] + 1));;
s) SUM[19]=$((SUM[19] + 1));;
t) SUM[20]=$((SUM[20] + 1));;
u) SUM[21]=$((SUM[21] + 1));;
v) SUM[22]=$((SUM[22] + 1));;
w) SUM[23]=$((SUM[23] + 1));;
x) SUM[24]=$((SUM[24] + 1));;
y) SUM[25]=$((SUM[25] + 1));;
z) SUM[26]=$((SUM[26] + 1));;
A) SUM[27]=$((SUM[27] + 1));;
B) SUM[28]=$((SUM[28] + 1));;
C) SUM[29]=$((SUM[29] + 1));;
D) SUM[30]=$((SUM[30] + 1));;
E) SUM[31]=$((SUM[31] + 1));;
F) SUM[32]=$((SUM[32] + 1));;
G) SUM[33]=$((SUM[33] + 1));;
H) SUM[34]=$((SUM[34] + 1));;
I) SUM[35]=$((SUM[35] + 1));;
J) SUM[36]=$((SUM[36] + 1));;
K) SUM[37]=$((SUM[37] + 1));;
L) SUM[38]=$((SUM[38] + 1));;
M) SUM[39]=$((SUM[39] + 1));;
N) SUM[40]=$((SUM[40] + 1));;
O) SUM[41]=$((SUM[41] + 1));;
P) SUM[42]=$((SUM[42] + 1));;
Q) SUM[43]=$((SUM[43] + 1));;
R) SUM[44]=$((SUM[44] + 1));;
S) SUM[45]=$((SUM[45] + 1));;
T) SUM[46]=$((SUM[46] + 1));;
U) SUM[47]=$((SUM[47] + 1));;
V) SUM[48]=$((SUM[48] + 1));;
W) SUM[49]=$((SUM[49] + 1));;
X) SUM[50]=$((SUM[50] + 1));;
Y) SUM[51]=$((SUM[51] + 1));;
Z) SUM[52]=$((SUM[52] + 1));;
*) SUM[53]=-1; return;;
esac
done
#echo ${SUM[*]}
}
# Check if two histograms are equal
hist_are_equal() {
# Array sizes differ?
[ ${#_h1[*]} != ${#SUM[*]} ] && return 1
# parsing input one index at a time
for ((i=0; i < ${#_h1[*]}; i++))
do
[ ${_h1[i]} != ${SUM[i]} ] && return 1
done
return 0
}
# Check if two histograms are equal
hist_are_equal2() {
# Array sizes differ?
local size=${#_h1[*]}
[ $size != ${#SUM[*]} ] && return 1
# parsing input one index at a time
for ((i=0; i < $size; i++))
do
[ ${_h1[i]} != ${SUM[i]} ] && return 1
done
return 0
}
# Filter out all words of incorrect length
# Use sum_word4 which generates a histogram of character frequency
alg6() {
sum_word4 $word
_h1=${SUM[*]}
grep_string="^`echo -n $word | tr 'a-zA-Z' '.'`\$"
grep "$grep_string" "$dict" | \
while read line
do
sum_word4 $line
if hist_are_equal
then
echo $line
fi
done
}
# Filter out all words of incorrect length
# Use sum_word4 which generates a histogram of character frequency
alg7() {
sum_word4 $word
_h1=${SUM[*]}
grep_string="^`echo -n $word | tr 'a-zA-Z' '.'`\$"
grep "$grep_string" "$dict" | \
while read line
do
sum_word4 $line
if hist_are_equal2
then
echo $line
fi
done
}
run_test() {
echo alg$1
eval time alg$1
}
#run_test 1
#run_test 2
#run_test 3
run_test 4
#run_test 5
run_test 6
#run_test 7
#!/usr/bin/perl
$myword=join("", sort split (//, $ARGV[0]));
shift;
while (<>) {
chomp;
print "$_\n" if (join("", sort split (//)) eq $myword);
}
Use it like this:
bla.pl < /usr/dict/words searchword
You want to find words containing only a given set of characters. A regex for that would be:
'^[letters_you_care_about]*$'
So, you could do:
grep "^[$W]*$" /usr/dict/words
The '^' matches the beginning of the line; '$' is for the end of the line. This means we must have an exact match, not just a partial match (e.g. "table").
'[' and ']' are used to define a group of possible characters allowed in one character space of the input file. We use this to find words in /usr/dict/word that only contain the characters in $W.
The '*' repeats the previous character (the '[...]' rule), which says to find a word of any length, where all the characters are in $W.
So we have the following:
n = length of input word
L = lines in dictionary file
If n tends to be small and L tends to be huge, might we be better off finding all permutations of the input word and looking for those, rather than doing something (like sorting) to all L lines of the dictionary file? (Actually, since finding all permutations of a word is O(n!), and we have to run through the entire dictionary file once for each word, maybe not, but I wrote the code anyway.)
This is Perl - I know you wanted command-line operations but I don't have a way to do that in shell script that's not super-hacky:
sub dedupe {
my (#list) = #_;
my (#new_list, %seen_entries, $entry);
foreach $entry (#list) {
if (!(defined($seen_entries{$entry}))) {
push(#new_list, $entry);
$seen_entries{$entry} = 1;
}
}
return #new_list;
}
sub find_all_permutations {
my ($word) = #_;
my (#permutations, $subword, $letter, $rest_of_word, $i);
if (length($word) == 1) {
push(#permutations, $word);
} else {
for ($i=0; $i<length($word); $i++) {
$letter = substr($word, $i, 1);
$rest_of_word = substr($word, 0, $i) . substr($word, $i + 1);
foreach $subword (find_all_permutations($rest_of_word)) {
push(#permutations, $letter . $subword);
}
}
}
return #permutations;
}
$words_file = '/usr/share/dict/words';
$word = 'table';
#all_permutations = dedupe(find_all_permutations($word));
foreach $permutation (#all_permutations) {
if (`grep -c -m 1 ^$permutation\$ $words_file` == 1) {
print $permutation . "\n";
}
}
This utility might interest you:
an -w "tab" -m 3
...gives bat and tab only.
The original author seems to not be around any more, but you can find information at http://packages.qa.debian.org/a/an.html (even if you don't want to use it itself, the source might be worth a look).